Excel – 当date落在两个用户设置参数之间时，复制并粘贴范围内的单元格

我非常渴望做这个macros观工作。 我想单击一个button来提示用户input开始date和结束date，然后macros从B：F中复制单元格数据，每行中的单元格A *包含从第4行开始的范围内的date。然后，到目标工作表并将信息粘贴到列H：L，从第7行开始。

源表格看起来像这样，其中行1-3专门用于表单信息，应该免除macros分析

| A | B | C | D | E | F | ----------------------------------------- 4 | Date |INFO |INFO |INFO |INFO |INFO | 5 | Date |INFO |INFO |INFO |INFO |INFO | 6 | Date |INFO |INFO |INFO |INFO |INFO | 7 | Date |INFO |INFO |INFO |INFO |INFO | 

目标工作表如下所示，第1-6行用于工作表信息。

  | H | I | J | K | L | ---------------------------------- 7 |INFO |INFO |INFO |INFO |INFO | 8 |INFO |INFO |INFO |INFO |INFO | 9 |INFO |INFO |INFO |INFO |INFO | 10 |INFO |INFO |INFO |INFO |INFO | 

我试图拼凑在一起的代码是

 Sub Copy_Click() Dim r As Range Set r = Range("B:F") startdate = CDate(InputBox("Begining Date")) enddate = CDate(InputBox("End Date")) For Each Cell In Sheets("SOURCE").Range("A:A") If Cell.Value >= startdate And Cell.Value <= enddate Then Sheets("SOURCE").Select r.Select Selection.Copy Sheets("DESTINATION").Select ActiveSheet.Range("H:L").Select ActiveSheet.Paste Sheets("SOURCE").Select End If Next End Sub 

这显然不起作用，并且没有指示将其粘贴到下一个可用的行，也没有指示粘贴到目的地表单上的第7行。

任何帮助将是惊人的！

Answer 1

未经testing：

 Sub Copy_Click() Dim startdate As Date, enddate As Date Dim rng As Range, destRow As Long Dim shtSrc As Worksheet, shtDest As Worksheet Dim c As Range Set shtSrc = Sheets("SOURCE") Set shtDest = Sheets("DESTINATION") destRow = 7 'start copying to this row startdate = CDate(InputBox("Begining Date")) enddate = CDate(InputBox("End Date")) 'don't scan the entire column... Set rng = Application.Intersect(shtSrc.Range("A:A"), shtSrc.UsedRange) For Each c In rng.Cells If c.Value >= startdate And c.Value <= enddate Then 'Starting one cell to the right of c, ' copy a 5-cell wide block to the other sheet, ' pasting it in Col H on row destRow c.Offset(0, 1).Resize(1, 5).Copy _ shtDest.Cells(destRow, 8) destRow = destRow + 1 End If Next End Sub