Перенос данных макросом(кнопкой) с листа на другой лист

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных макросом(кнопкой) с листа на другой лист (Формулы/Formulas)

Davasagi

Дата: Пятница, 17.06.2022, 19:18 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

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

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

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

К сообщению приложен файл: _2.xlsx (59.5 Kb)

Ответить

Nic70y

Дата: Суббота, 18.06.2022, 08:47 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 8759

Репутация: 2272 ±

Замечаний: 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

Ответить

Davasagi

Дата: Среда, 22.06.2022, 22:36 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

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

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

Сообщение отредактировал Davasagi - Четверг, 23.06.2022, 09:27

Ответить

Davasagi

Дата: Среда, 22.06.2022, 22:36 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

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

Ответить

Страница 1 из 1
1