Question

我有一个“中断”工作表表，可以在其中输入带有开始日期和结束日期的信息。输入信息后，“提前2周查看”按钮将运行一个宏，以将接下来2周内的所有行复制到“提前2周查看”工作表。

该信息将复制到“提前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

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

1 个答案: