如果两个工作簿中的两列具有相同的值,我希望将数据从一个工作簿复制到另一个工作簿



如果两个工作簿中的两列具有相同的值,则我希望将数据从一个工作簿复制到另一个工作簿(如果两个工作薄中的A列和B列具有相同值,则复制并粘贴C列和D列(

我申请了下面的代码,但它给出了";下标超出范围";第一环路错误

Sub transfer()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim companyname As String
Dim activistname As String

Workbooks.Open Filename:="C:UsersPrathameshADesktopfinal_eventsdata.csv"
Sheets("final_eventsdata").Activate
lastrow1 = Sheets("final_eventsdata").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
companyname = Sheets("final_eventsdata").Cells(i, "B").Value
activistname = Sheets("final_eventsdata").Cells(i, "I").Value

Workbooks("Live_Macro").Activate
Worksheets("Live").Activate
lastrow2 = Sheets("Live").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To lastrow2
If Sheets("Live").Cells(j, "A").Value = companyname And Sheets("Live").Cells(j, "B").Value = activistname Then
Workbooks("final_eventsdata").Activate
Sheets("final_eventsdata").Activate
Sheets("final_eventsdata").Range(Cells(i, "C"), Cells(i, "F")).Copy
Workbooks("Live_Macro").Activate
Sheets("Live").Activate
Sheets("Live").Range(Cells(j, "C"), Cells(j, "F")).Select
ActiveSheet.Paste

End If
Next j
Application.CutCopyMode = False
Next i
Sheets("Live").Activate
Sheets("Live").Range("A1").Select
End Sub

使用多个工作簿时,在引用这些工作簿中的对象(例如工作表(时,应确保包含工作簿引用。

您还应该避免使用Activate在工作簿/工作表之间切换,这是不需要的,可能会导致问题。

运行这类代码时,一个好主意是创建引用所涉及的特定工作簿/工作表等的变量,这是我在以下代码的前几行中没有提到的。

Option Explicit
Sub transfer()
Dim wbEvents As Workbook
Dim wsEvents As Worksheet
Dim wbLive As Workbook
Dim wsLive As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim companyname As String
Dim activistname As String
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Set wbLive = Workbooks("Live Macro")
Set wsLive = wbLive.Sheets("Live")
Set wbEvents = Workbooks.Open(Filename:="C:UsersPrathameshADesktopfinal_eventsdata.csv")
Set wsEvents = wbEvents.Sheets(1)
lastrow1 = wsEvents.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
companyname = wsEvents.Cells(i, "B").Value
activistname = wsEvents.Cells(i, "I").Value
lastrow2 = wsLive.Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To lastrow2
If wsLive.Cells(j, "A").Value = companyname And wsLive.Cells(j, "B").Value = activistname Then
With wsEvents
Set rngSrc = .Range(.Cells(i, "C"), .Cells(i, "F"))
End With
With wsLive
Set rngDst = .Range(.Cells(j, "C"), .Cells(j, "F"))
End With
rngSrc.Copy rngDst
End If
Next j
Application.CutCopyMode = False
Next i
End Sub

最新更新