VB: Comparing two cells in separate sheets and copy adjacent cells to a new sheet

[PolAmer]

Hi,
I'm trying to compare CustomerID #s in two separate worksheets (WS2 and WS1) and when there is a match copy the customerID # and next 50 adjacent cells from WS1 to the new sheet.
I am having issues coping the data to a new worksheet (Ws3). Any help would be greatly appreciated.

Sub Customers()

Dim Cl As Range
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
Set Ws3 = Sheets("Sheet3")

With CreateObject("scripting.dictionary")

For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Cl.Offset(, 1).Resize(, 50)
Next Cl
For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
Cl.Offset(, 10).Resize(, 50).Value = .Item(Cl.Value)

Next Cl

End With
End Sub

 

[Alex Blakenburg]

Try changing your output line to this:-

            Ws3.Range(Cl.Address).Offset(, 10).Resize(, 50).Value = .Item(Cl.Value)

 

[Fluff]

Or maybe

Sub Customers()

   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Sheet2")
   Set Ws3 = Sheets("Sheet3")
   
   With CreateObject("scripting.dictionary")
   
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Resize(, 51)
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            Ws3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 51).Value = .Item(Cl.Value)
         End If
      Next Cl
   
   End With
End Sub

 

[PolAmer]

Thanks to both of you.

 

[Fluff]

Glad we could help & thanks for the feedback.