Excel 按单元格值从一个工作簿复制到另一个工作簿

我试图在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

---

我在你的代码中做了一些修改，希望它能以这种方式解决你的问题

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

---

查看您在何处执行

x.Sheets（“Sheet1”）…

？您正在指定所使用的

工作簿
工作表（“Sheet1”）
。对于
行（）
，
列（）
，
单元格（）
也需要这样做。因此，在每一个宏中，放置希望运行的
行数
，即：
lr=Sheets（“Sheet1”）。单元格（Sheets（“Sheet1”）。Rows.Count，“A”）。End（xlUp）。Row
问题在于
范围
和
行
。您需要符合您想要使用的特定工作簿和工作表的条件，就像您编写
lr2=y.Sheets（“Sheet1”）时一样。单元格谢谢你们！上面的编辑现在可以工作了。