Excel VBA - копировать строки таблицы на другой лист, если он находится в диапазоне дат

Question

У меня есть таблица «Outages», в которую я вводю информацию с указанием даты начала и окончания. После того, как информация введена, кнопка «2 недели просмотра вперед» запустит макрос, чтобы скопировать любые строки, которые находятся в течение следующих 2 недель, в «2 недели просмотра вперед».

Рабочий лист "Отключения"

Информация копируется на лист "2 Week Look Ahead", но дублирует данные в следующем ряду и сдвигает их влево.

Рабочий лист "2 недели впереди"

Я новичок в 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