如何在一天中的特定时间将单元格范围复制到新工作表上的最后一行空行

时间:2018-05-30 12:45:17

标签: excel excel-vba vba

这是我的第一篇文章,所以非常感谢所有的帮助!

基本上我正在尝试做什么..我想要一个宏来复制一系列包含动态数据(RTD)的单元格("摘要"表格)到一个新的工作表(&#34) ;在特定时间捕获数据")。现在,我绝不是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

再一次,非常感谢任何帮助!

1 个答案:

答案 0 :(得分:0)

我真的不了解OnTimeTimeSerial,但你说你的问题在于粘贴数据。如果是这种情况,请尝试以下方法。

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