EXCEL VBA将数据从一周复制到另一个表单中

我在工作簿中有两张纸，一张是所有数据（“hdagarb”），另一张是“摘要”。 在数据表中，第2列有名称，第5列有date。 这些是我关心的专栏。 我想获取所有在6月9日结束的所有行，并将第2列中的名称和第5列中的date复制并粘贴到我的汇总表中。 目前，我甚至无法将其复制并粘贴列2名称。 这是我的代码：

Sub finddata() Dim todaysdate As Date Dim thisweek As Date Dim lastweek As Date Dim finalrow As Long Dim Rdate As Date Dim i As Long Sheets("Summary").Range("H5:H1000").ClearContents todaysdate = Date thisweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate lastweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate - 7 finalrow = Sheets("HDAGarb").Range("A100000").End(xlUp).Row For i = 2 To finalrow Rdate = Sheets("hdagarb").Cells(i, 5) If Rdate > lastweek Then Sheets("hdagarb").Cells(i, 2).Copy Sheets("Summary").Range("H100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats End If Next i Worksheets("summary").Activate Worksheets("summary").Range("H5").Select End Sub 

第5列的源数据是这样的

 02-Jun-2017 - - - - 12-Apr-2017 01-May-2017 

我希望脚本忽略没有date的条目（“ – ”）。

Answer 1

如果E列中有一个有效的date，以下代码将仅执行副本：

 Sub finddata() Dim todaysdate As Date Dim thisweek As Date Dim lastweek As Date Dim finalrow As Long Dim newRow As Long Dim Rdate As Date Dim i As Long Dim srcSheet As Worksheet Dim dstSheet As Worksheet todaysdate = Date thisweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate lastweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate - 7 Set srcSheet = Worksheets("HDAGarb") Set dstSheet = Worksheets("Summary") finalrow = srcSheet.Range("A" & srcSheet.Rows.Count).End(xlUp).Row dstSheet.Range("H5:H" & dstSheet.Cells(dstSheet.Rows.Count, "H").End(xlUp).Row).ClearContents newRow = 4 For i = 2 To finalrow If IsDate(srcSheet.Cells(i, "E").Value) Then Rdate = CDate(srcSheet.Cells(i, 5).Value) If Rdate > lastweek Then 'or If Rdate > lastweek And Rdate <= thisweek Then '??? newRow = newRow + 1 srcSheet.Cells(i, "B").Copy dstSheet.Cells(newRow, "H").PasteSpecial xlPasteFormulasAndNumberFormats 'Not sure whether you wanted the next two lines srcSheet.Cells(i, "E").Copy dstSheet.Cells(newRow, "I").PasteSpecial xlPasteFormulasAndNumberFormats End If End If Next i dstSheet.Activate dstSheet.Range("H5").Select End Sub 

我还更改了它以跟踪正在写入汇总表中的行，以便如果HDAGarb表单中的某个名称为空，它仍然会复制它和相关的date。 （如果你不需要重新计算哪一个是最后一行的话，速度也会更快。）