VBA将值从一个工作簿复制到另一个值匹配的另一个工作簿？

我有两个工作簿：

“LO Delivery Tracker”

Col A 01/01/2017 02/01/2017 15/01/2017 15/03/2017 12/03/2017 

另一个名为“报告”的工作手册

  A1 = 01 Column E A2 = 2017 

我想在“LO Delivery Tracker”的工作表1中search我在“报表”工作簿中与单元格A1中的月份和单元格A2中的年份匹配的date的列。

然后，我想将“LO Delivery Tracker”工作簿中的所有匹配值复制到“Report”工作簿的E列中。

预期结果：

 Column E 01/01/2017 02/01/2017 15/01/2017 

这是我试过的：

 Sub CopyBasedonSheet1() 'open workbook if not open Dim WB As Workbook On Error Resume Next Set WB = Workbooks("LO Delivery Tracker.xlsm") On Error GoTo 0 If WB Is Nothing Then Set WB = Workbooks.Open("C:\Users\Mark O'Brien\Desktop\LO Delivery Tracker.xlsm") End If Dim i As Long Dim j As Long Sheet1LastRow = ThisWorkbook.Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row Sheet2LastRow = WB.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row For j = 1 To Sheet1LastRow For i = 1 To Sheet2LastRow If Month(WB.Worksheets(1).Cells(i, 4).Value) = ThisWorkbook.Worksheets(1).Range("O8").Value Then ThisWorkbook.Worksheets(2).Cells(j).Value = WB.Worksheets(1).Cells(i, 1).Value Else End If Next i Next j End Sub 

我是全新的vba，所以我很确定我做错了。 请有人告诉我我要去哪里错了吗？

编辑

用@Shai Rado提供的代码

 Option Explicit Sub CopyBasedonSheet1() Dim WB As Workbook Dim i As Long Dim j As Long Dim LastRow As Long On Error Resume Next Set WB = Workbooks("LO Lines Delivery Tracker.xlsm") On Error GoTo 0 If WB Is Nothing Then 'open workbook if not open Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) LO Delivery Tracking\LO Lines Delivery Tracker.xlsm") End If With WB.Worksheets(1) LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row j = 1 For i = 1 To LastRow If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(WB.Worksheets(1).Range("A" & i).value) Then ' check if Month equals the value in "A1" If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(WB.Worksheets(1).Range("A" & i).value) Then ' check if Year equals the value in "A2" ThisWorkbook.Worksheets(2).Range("E" & j).value = WB.Worksheets(1).Range("A" & i).value j = j + 1 End If End If Next i End With End Sub 

编辑2：

好的，对@Shai Rado表示歉意，我正在查找传递跟踪工作簿的A列，但是我的date在B列。

请参阅更新的代码。 现在我得到了这一行types不匹配的错误：

 If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("B" & i).value) Then ' check if Month equals the value in "A1" 

码

 Option Explicit Sub CopyBasedonSheet1() Application.ScreenUpdating = False Dim app As New Excel.Application app.Visible = False 'Visible is False by default, so this isn't necessary Dim WB As Workbook Dim i As Long Dim j As Long Dim LastRow As Long On Error Resume Next Set WB = Workbooks("LO Lines Delivery Tracker.xlsm") On Error GoTo 0 If WB Is Nothing Then 'open workbook if not open Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) LO Delivery Tracking\LO Lines Delivery Tracker.xlsm") End If With WB.Worksheets(1) LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row j = 1 For i = 1 To LastRow If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("B" & i).value) Then ' check if Month equals the value in "A1" If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(.Range("B" & i).value) Then ' check if Year equals the value in "A2" ThisWorkbook.Worksheets(2).Range("E" & j).value = .Range("B" & i).value j = j + 1 End If End If Next i End With Application.ScreenUpdating = True End Sub 

编辑3：

@Shai Rado，代码目前看起来像这样：

选项显式

 Sub CopyBasedonSheet1() Dim WB As Workbook Dim i As Long Dim j As Long Dim LastRow As Long On Error Resume Next Set WB = Workbooks("LO Lines Delivery Tracker.xlsm") On Error GoTo 0 If WB Is Nothing Then 'open workbook if not open Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) LO Delivery Tracking\LO Lines Delivery Tracker.xlsm") End If ' ======= Edit #2 , also for DEBUG ====== With WB.Worksheets(1) LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row j = 1 For i = 1 To LastRow ' === For DEBUG ONLY === Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F9").value) Debug.Print Month(.Range("B" & i).value) Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F10").value) Debug.Print Year(.Range("B" & i).value) If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("B" & i).value) Then ' check if Month equals the value in "A1" If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(.Range("B" & i).value) Then ' check if Year equals the value in "A2" MsgBox "OK, Passed the 2 Ifs" ThisWorkbook.Worksheets(2).Range("E" & j).value = .Range("B" & i).value j = j + 1 End If End If Next i End With End Sub 

源工作簿，送货跟踪器，（我从哪里复制date）：

列的格式

复制到工作簿：报告，工作表1包含单元格F9和F10 <— F9和F10都明确以数字格式build议。

复制到工作簿：报表，sheet2（我需要将数据粘贴到列E）

Answer 1

下面的代码将遍历“LO Delivery Tracker”工作簿中工作表（1）的A列中的所有值，并将Month和Year与ThisWorkbook Worksheets（1）中的列A中的值进行比较。 结果在工作表（1）的E栏中。

注意 ：请记住，使用Worksheets(1)是有风险的，如果您更改工作簿中工作表的顺序，则会出现错误或意外的结果。 我更喜欢引用Worksheet.Name ，像Worksheets("MySheetName") 。

码

 Option Explicit Sub CopyBasedonSheet1() Dim WB As Workbook Dim i As Long Dim j As Long Dim LastRow As Long On Error Resume Next Set WB = Workbooks("LO Delivery Tracker.xlsm") On Error GoTo 0 If WB Is Nothing Then 'open workbook if not open Set WB = Workbooks.Open("C:\Users\Mark O'Brien\Desktop\LO Delivery Tracker.xlsm") End If ' ======= Edit #2 , also for DEBUG ====== With WB.Worksheets(1) LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row j = 1 For i = 1 To LastRow ' === For DEBUG ONLY === Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F9").Value) Debug.Print Month(.Range("B" & i).Value) Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F10").Value) Debug.Print Year(.Range("B" & i).Value) If CInt(ThisWorkbook.Worksheets(1).Range("F9").Value) = Month(.Range("B" & i).Value) Then ' check if Month equals the value in "A1" If CInt(ThisWorkbook.Worksheets(1).Range("F10").Value) = Year(.Range("B" & i).Value) Then ' check if Year equals the value in "A2" MsgBox "OK, Passed the 2 Ifs" ThisWorkbook.Worksheets(2).Range("E" & j).Value = .Range("B" & i).Value j = j + 1 End If End If Next i End With End Sub 

运行此代码后的结果屏幕截图：