Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перенос данных макросом(кнопкой) с листа на другой лист - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Перенос данных макросом(кнопкой) с листа на другой лист
Davasagi Дата: Пятница, 17.06.2022, 19:18 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Добрый вечер, прошу помощи у экспертного сообщества, в решении(сокращении) цикличных идентичных каждодневных действий.

Данная таблица представляет собой некий реестр документооборота, список документов, согласуем и представленных в архив.
Необходим макрос для автоматического переноса данных, с одного листа ("Проверка") в определенные свободные ячейки другого листа ("Согласование"),
при условии заполнения всех необходимых ячеек, далее очищение ячеек от данных на первом листе.

Подскажите пожалуйста как реализовать такую задачу(
Заранее благодарю.
К сообщению приложен файл: _2.xlsx (59.5 Kb)
 
Ответить
СообщениеДобрый вечер, прошу помощи у экспертного сообщества, в решении(сокращении) цикличных идентичных каждодневных действий.

Данная таблица представляет собой некий реестр документооборота, список документов, согласуем и представленных в архив.
Необходим макрос для автоматического переноса данных, с одного листа ("Проверка") в определенные свободные ячейки другого листа ("Согласование"),
при условии заполнения всех необходимых ячеек, далее очищение ячеек от данных на первом листе.

Подскажите пожалуйста как реализовать такую задачу(
Заранее благодарю.

Автор - Davasagi
Дата добавления - 17.06.2022 в 19:18
Nic70y Дата: Суббота, 18.06.2022, 08:47 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 9005
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub u_726()
    Application.ScreenUpdating = False  'отключаем обновление экрана
    a = Application.CountA(Sheets("Проверка").Range("a2:f2"))   'кол-во заполненных ячеек
    If a = 6 Then                    'если их 6 переносим данные
        b = Sheets("Согласование").Cells(Rows.Count, "a").End(xlUp).Row + 1                         'строка вставки
        Sheets("Согласование").Range("a" & b) = Sheets("Согласование").Range("a" & b - 1) + 1       '№
        Sheets("Согласование").Range("b" & b & ":e" & b) = Sheets("Проверка").Range("a2:d2").Value  'Вид документа   № документа Дата документа  № договора
        Sheets("Согласование").Range("h" & b & ":j" & b) = Sheets("Проверка").Range("e2:g2").Value  'Согласование №  Статус  Примечание
        Sheets("Проверка").Range("a2:g2").ClearContents     'очистка
    Else
        MsgBox "Заполнены не все ячейки!"
    End If
    Application.ScreenUpdating = True   'включаем обновление экрана
End Sub
[/vba]
К сообщению приложен файл: 6404497.xlsm (68.5 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщение[vba]
Код
Sub u_726()
    Application.ScreenUpdating = False  'отключаем обновление экрана
    a = Application.CountA(Sheets("Проверка").Range("a2:f2"))   'кол-во заполненных ячеек
    If a = 6 Then                    'если их 6 переносим данные
        b = Sheets("Согласование").Cells(Rows.Count, "a").End(xlUp).Row + 1                         'строка вставки
        Sheets("Согласование").Range("a" & b) = Sheets("Согласование").Range("a" & b - 1) + 1       '№
        Sheets("Согласование").Range("b" & b & ":e" & b) = Sheets("Проверка").Range("a2:d2").Value  'Вид документа   № документа Дата документа  № договора
        Sheets("Согласование").Range("h" & b & ":j" & b) = Sheets("Проверка").Range("e2:g2").Value  'Согласование №  Статус  Примечание
        Sheets("Проверка").Range("a2:g2").ClearContents     'очистка
    Else
        MsgBox "Заполнены не все ячейки!"
    End If
    Application.ScreenUpdating = True   'включаем обновление экрана
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 18.06.2022 в 08:47
Davasagi Дата: Среда, 22.06.2022, 22:36 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, добрый вечер!

Огромное спасибо, почти все работает))
Но единственное, он переносит данные в самый конец и создает свою нумерацию.
Это проблема, так как список будет всегда расти и пустые строчки сверху не будут автоматически заполняться.
Как можно решить данную проблему, подскажите пожалуйста.


Сообщение отредактировал Davasagi - Четверг, 23.06.2022, 09:27
 
Ответить
СообщениеNic70y, добрый вечер!

Огромное спасибо, почти все работает))
Но единственное, он переносит данные в самый конец и создает свою нумерацию.
Это проблема, так как список будет всегда расти и пустые строчки сверху не будут автоматически заполняться.
Как можно решить данную проблему, подскажите пожалуйста.

Автор - Davasagi
Дата добавления - 22.06.2022 в 22:36
Davasagi Дата: Среда, 22.06.2022, 22:36 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, и прошу прощения, сразу не увидел Ваш ответ, почему-то уведомления не было(
 
Ответить
СообщениеNic70y, и прошу прощения, сразу не увидел Ваш ответ, почему-то уведомления не было(

Автор - Davasagi
Дата добавления - 22.06.2022 в 22:36
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!