Как скопировать диапазон ячеек в последнюю пустую строку на новом листе в определенное время суток

Question

Это мой первый пост, поэтому вся помощь будет принята с благодарностью!

В основном то, что я пытаюсь сделать .. Я хотел бы, чтобы макрос скопировал диапазон ячеек (таблица «Сводка»), которые содержат динамические данные (RTD), на новый рабочий лист («Захват данных»)в определенное время.Теперь я ни в коем случае не эксперт VBA, но у меня есть некоторый опыт программирования.В Интернете я тоже внимательно осмотрелся, и ниже приведено то, что мне удалось спасти, но оно не копирует все ячейки в диапазоне, а только копирует первую ячейку.

Этот блок кода находится в объекте "ThisWorkbook", который должен запускать макрос вовремя:

Private Sub Workbook_Open()
dNextTime = TimeSerial(14, 30, 0)
dNextTime = Date + dNextTime + IIf(Now > (Date + dNextTime), 1, 0)
Application.OnTime dNextTime, "CaptureHeadlines"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime dNextTime, "CaptureHeadlines", Schedule:=False
On Error GoTo 0
End Sub

А приведенный ниже блок кода находится в папке "Module1", котораяскопировать содержимое диапазона ячеек на новый лист:

Public dNextTime As Double

Sub CaptureHeadlines()

Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets("Summary")
Set pasteSheet = Worksheets("Data capture")

copySheet.Range("B21:O37").Copy
pasteSheet.Range(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial 
Paste:=xlPasteAll

Application.CutCopyMode = False

dNextTime = dNextTime + 1
Application.OnTime dNextTime, "CaptureHeadlines"

End Sub

Опять же, любая помощь очень ценится!

Answer 1

Я действительно ничего не знаю о OnTime или TimeSerial, но вы сказали, что ваша проблема заключалась в вставке данных.Если это так, попробуйте следующее.

Sub CaptureHeadlines()

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim LastRowPasteSheet As Long

    Set copySheet = Worksheets("Summary")
    Set pasteSheet = Worksheets("Data capture")
    LastRowPasteSheet = pasteSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

    copySheet.Range("B21:O37").Copy
    pasteSheet.Range("A" & LastRowPasteSheet).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False

End Sub