Excel VBA Макросы: Скопировать данные из одного листа на другой и добавить вчерашнюю дату.

Автор Mikhail87, 03 марта 2020, 18:21

Mikhail87

Необходимо написать макрос, который копирует данные из вкладки «Данные за вчера» во вкладку «Итого» и записывает вчерашнюю дату напротив каждой строчки.

Каждый день на вкладке «Данные за вчера» данные перезатираются и появляются новые данные, а вкладка «Итого» - это данные за весь период с указанием даты.

[вложение удалено администратором]

Администратор

Макрос
Sub Макрос()

    Dim sh_src As Worksheet, sh_res As Worksheet
    Dim lr_res As Long, lr As Long
   
   
    ' Отключаем монитор, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    '1. Даём листам имена. Далее в коде будем использовать эти имена.
    Set sh_src = Worksheets("Данные за вчера")
    Set sh_res = Worksheets("Итого")
   
    '2. Сбрасываем автофильтры на всякий случай.
    If sh_src.AutoFilterMode Then sh_src.ShowAllData
    If sh_res.AutoFilterMode Then sh_res.ShowAllData
   
    '3. Поиск последней строки на листе-результате по столбцу A.
        ' End не ищет в скрытых строках.
    lr_res = sh_res.Cells(sh_res.Rows.Count, "A").End(xlUp).Row
   
    '4. Копирование данных из одного листа на другой.
    '1) Ищем последнюю строку.
        ' End не ищет в скрытых строках.
    lr = sh_src.Cells(sh_src.Rows.Count, "A").End(xlUp).Row
    '2) Если нет данных.
    If lr = 1 Then
        Application.ScreenUpdating = True
        MsgBox "За вчера нет данных.", vbInformation
        Exit Sub
    End If
    '3) Копирование данных.
    sh_src.Range("A2:E" & lr).Copy sh_res.Cells(lr_res + 1, "A")
   
    '5. Вставка вчерашней даты на лист-результат в столбец F.
    '1) Поиск последней строки на листе-результате после вставки данных.
        ' End не ищет в скрытых строках.
    lr = sh_res.Cells(sh_res.Rows.Count, "A").End(xlUp).Row
    '2) Вставка даты.
    sh_res.Columns("F").Rows(lr_res + 1 & ":" & lr).Value = Date - 1
   
    '6. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub
[свернуть]