Excel VBA - 如果在日期范围内，将表格行复制到另一个工作表

Question

我有一个“停机”工作表，我在其中输入了开始日期和结束日期的信息。输入信息后，“2 周前瞻”按钮将运行宏以将未来 2 周内的任何行复制到“2 周前瞻”工作表中。

"Outages" worksheet

信息复制到“2 周展望”表，但它复制下一行的数据，并将其向左移动。

"2 Week Look Ahead" worksheet

我是 VBA 新手。有人可以帮我清理我的代码并解决这个问题吗？

Sub Copy_Click()
' Prompt for confirmation before clearing current 2 Week Look Ahead

Dim varResponse As Variant
varResponse = MsgBox("Clear the current 2 Week Lookahead and continue?", vbYesNo, "Selection")
If varResponse <> vbYes Then Exit Sub

ThisWorkbook.Sheets("2 Week Look Ahead").Range("10:1000").Delete xlUp ' Clears 2 Week Look Ahead sheet, rows 10-1000

' Set Variables
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 '-- this is used to store the single cell in the For Each loop

Set shtSrc = Sheets("Outages") ' Sets "Outages" sheet as source
Set shtDest = Sheets("2 Week Look Ahead") 'Sets "2 Week Look Ahead" as destination

destRow = 10 'Start copying to this row on destination sheet

' Use 2 week date range from this week's start

startdate = CDate(ThisWorkbook.Sheets("2 Week Look Ahead").Range("G7"))  ' Use this week Sunday date for start date
enddate = CDate(ThisWorkbook.Sheets("2 Week Look Ahead").Range("I7")) ' Use 2 weeks from Sunday date for end date

' Set range to search for dates in 2 week period
Set rng = Application.Intersect(shtSrc.Range("C5:D1000"), shtSrc.UsedRange)

'Look for matching dates in columns C5 to D1000
For Each c In rng.Cells
    If c.Value >= startdate And c.Value <= enddate Then ' Does date fall between start and end dates? If Yes, then copy to destination sheet

        c.Offset(0, -2).Resize(1, 12).Copy _
                      shtDest.Cells(destRow, 1) 'Copy a 12 cell wide block to the other sheet, paste into Column A on row destRow

        destRow = destRow + 1

    End If 'Ends search for dates
Next
Sheets("2 Week Look Ahead").Activate ' Changes view to 2 Week Look Ahead Sheet


End Sub

Answer 1

调整以下，

' Set range to search for dates in 2 week period
Set rng = Application.Intersect(shtSrc.Range("C5:D1000"), shtSrc.UsedRange)

...到，

Set rng = Application.Intersect(shtSrc.Range("C5:C1000"), shtSrc.UsedRange)

...还有，

 ' Does date fall between start and end dates? If Yes, then copy to destination sheet
 If c.Value >= startdate And c.Value <= enddate Then

...到，

 If (c.Value >= startdate And c.Value <= enddate) Or _
    (c.offset(0, 1).Value >= startdate And c.offset(0, 1).Value <= enddate) Then