通過單元格值從一個工作簿復制到另一個工作簿

Question

我試圖在Excel中編寫VBA腳本，以編程方式將包含今天日期的所有行從一個工作簿復制到另一個工作簿。 為了弄清楚這一點，我編寫了兩個工作腳本來處理預期操作的各個方面，並編寫了一個非工作腳本來嘗試協調這兩個方面。

第一個工作腳本將專門標識的單元格從一個工作簿復制到另一個工作簿：

Sub Button1_Click()

Set x = ThisWorkbook
Set y = Workbooks.Open("\\networpath\Test2.xlsx")

x.Sheets("Sheet1").Range("A2").Copy Destination:=y.Sheets("Sheet1").Range("A2")

End Sub

第二個工作腳本將特定列中包含今天日期的所有行從同一工作簿的一個工作表復制到另一個工作表：

Sub Button2_Click()

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("B" & r).Value = Date Then
        Rows(r).Copy Destination:=Sheets("Sheet2").Range("A" & lr2 + 1)
        lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r

End Sub

我的想法是，既然這兩項工作都能完成，但如果將它們放在一起，它也應該工作。 到目前為止，結果是此無效腳本：

Sub Button3_Click()

Set x = ThisWorkbook
Set y = Workbooks.Open("\\networkpath\Test2.xlsx")

Dim lr As Long, lr2 As Long, r As Long
lr = x.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = y.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("B" & r).Value = Date Then
        Rows(r).Copy Destination:=Sheets("Sheet1").Range("A" & lr2 + 1)
        lr2 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    End If
Next r

End Sub

該腳本不會產生任何錯誤。 它成功打開了第二個文件Test2.xlsx 。 但是，沒有數據被復制到第二個文件中。 知道我在做什么錯嗎？

編輯：解決

經過以上修改的工作腳本：

Sub Button3_Click()

Dim x As Workbook, y As Workbook, lr As Long, lr2 As Long, r As Long

Set x = ThisWorkbook
Set y = Workbooks.Open("\\networkpath\Test2.xlsx")

lr = x.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = y.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If x.Sheets("Sheet1").Range("B" & r).Value = Date Then
        x.Sheets("Sheet1").Rows(r).Copy Destination:=y.Sheets("Sheet1").Range("A" & lr2 + 1)
        lr2 = y.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    End If
Next r

End Sub

Answer 1

我更改了代碼中的一些內容，希望它可以通過這種方式解決您的問題。

Sub Button3_Click()

    Dim x As Workbook
    Dim y As Workbook
    Dim datToday As Date

    datToday = Date

    Set x = ThisWorkbook
    Set y = Workbooks.Open("\\networkpath\Test2.xlsx")

    Dim lr As Long, lr2 As Long, r As Long
    lr = x.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    lr2 = 0
    For r = 1 To lr
        x.Activate
        If Range("B" & r).Value = datToday Then
            x.Sheets("Sheet1").Rows(r).Copy Destination:=y.Sheets("Sheet1").Range("A" & lr2 + 1)
            lr2 = y.Sheets("Sheet1").UsedRange.Rows.Count
        End If
    Next r

    End Sub