For/next loop VBA to cycle through named sheets on ThisWorkbook & Import data to unique IDs

[MurdochQuill]

Hi,

I have this code here, which can currently match up single sheets to external references.
So it basically Searches col A on each workbook for matching unique ID's, then brings across the data in col B from the Patcher wb Import sheet.

I'm not sure how I can change this code to cycle through each sheet on the destination workbook (ThisWorkbook, tb), as the LastRw1 is hardcoded to each sheet. I'm a bit stuck on how to enter this in a look so it will make these variables up in the format of "For Each ws In ThisWorkbook" or something like that.

Here's the code so far:

Sub Patcher()
Dim lastRw1, lastRw2, nxtRw, m
Dim wb As Workbook
Dim ws As Worksheet
   
    Set tb = ThisWorkbook
   
     For Each wb In Application.Workbooks
        If wb.Name Like "Patcher*" And wb.Name <> tb.Name Then
            
             lastRw2 = wb.Sheets("Import").Range("A" & Rows.Count).End(xlUp).Row
             lastRw1 = tb.Sheets("Destination").Range("A" & Rows.Count).End(xlUp).Row
        End If

        For nxtRw = 1 To lastRw2
            With tb.Sheets("Destination").Range("A1:A" & lastRw1)
                      Set m = .Find(wb.Sheets("Import").Range("A" & nxtRw), LookIn:=xlValues, lookat:=xlWhole)
                            If Not m Is Nothing Then
                                 wb.Sheets("Import").Range("B" & nxtRw & ":O" & nxtRw).Copy _
                               Destination:=tb.Sheets("Destination").Range("B" & m.Row)
                       
                            End If
             End With
         Next
    Next wb
            
End Sub

Any help would be really appreciated !

 

[EFANYoutube]

Does every sheet in the patcher workbook have the right data or is there some sheets you don't want to process?
I do see some issues with your code, and i can see how it can be optimised. Does you code work usually? Or are there some bugs?

Sub Patcher()
Dim lastRw1, lastRw2, nxtRw, m
Dim wb As Workbook
Dim ws As Worksheet
 
    Set tb = ThisWorkbook
 
     For Each wb In Application.Workbooks
        For Each ws In wb.Worksheets
            If wb.Name Like "Patcher*" And wb.Name <> tb.Name Then
              
                lastRw2 = wb.Sheets("Import").Range("A" & Rows.Count).End(xlUp).Row
                lastRw1 = tb.Sheets("Destination").Range("A" & Rows.Count).End(xlUp).Row
          
  
                For nxtRw = 1 To lastRw2
                    With tb.Sheets("Destination").Range("A1:A" & lastRw1)
                            Set m = .Find(wb.Sheets("Import").Range("A" & nxtRw), LookIn:=xlValues, lookat:=xlWhole)
                            If Not m Is Nothing Then
                                m.Offset(,1).Copy _ 'wb.Sheets("Import").Range("B" & nxtRw & ":O" & nxtRw).Copy
                                Destination:=tb.Sheets("Destination").Range("B" & m.Row)
                          
                            End If
                     End With
                 Next
             End If
        Next ws
    Next wb
          
End Sub

 

[EFANYoutube]

I don't think I understand your workbokks cause the code you have given is a bit odd
It pastes the data in the destination sheet in the same row as it is in the source?

 

[MurdochQuill]

Does every sheet in the patcher workbook have the right data or is there some sheets you don't want to process?
I do see some issues with your code, and i can see how it can be optimised. Does you code work usually? Or are there some bugs?

Sub Patcher()
Dim lastRw1, lastRw2, nxtRw, m
Dim wb As Workbook
Dim ws As Worksheet
 
    Set tb = ThisWorkbook
 
     For Each wb In Application.Workbooks
        For Each ws In wb.Worksheets
            If wb.Name Like "Patcher*" And wb.Name <> tb.Name Then
         
                lastRw2 = wb.Sheets("Import").Range("A" & Rows.Count).End(xlUp).Row
                lastRw1 = tb.Sheets("Destination").Range("A" & Rows.Count).End(xlUp).Row
     
 
                For nxtRw = 1 To lastRw2
                    With tb.Sheets("Destination").Range("A1:A" & lastRw1)
                            Set m = .Find(wb.Sheets("Import").Range("A" & nxtRw), LookIn:=xlValues, lookat:=xlWhole)
                            If Not m Is Nothing Then
                                m.Offset(,1).Copy _ 'wb.Sheets("Import").Range("B" & nxtRw & ":O" & nxtRw).Copy
                                Destination:=tb.Sheets("Destination").Range("B" & m.Row)
                     
                            End If
                     End With
                 Next
             End If
        Next ws
    Next wb
     
End Sub

Yeah it works. Ah, should we just throw a loop around the entire thing ?
I'm basically just grabbing col B from the import sheet on patcher wb, then pasting it against the same ID's in sheets on destination sheets in ThisWorkbook.

I would ideally want to only process sheets with specific names, but there are 10+ sheets.

 

[EFANYoutube]

Did you try the one I posted? I have added the loop already.
Do you want ALL sheets on source WB or just spacific ones?

 

[MurdochQuill]

Did you try the one I posted? I have added the loop already.
Do you want ALL sheets on source WB or just spacific ones?

Yes, sorry for my edits. Ideally multiple sheets.

I also tried yours. the loop is fine, however the references to Sheet("Destination") need to cycle through the worksheets instead of being hard-coded... Which is where i'm stuck

 

[MurdochQuill]

Nevermind. I got it. Thanks for the nudging in the right direction!!!

Sub PatcherRuns()
Dim lastRw1, lastRw2, nxtRw, m
Dim wb As Workbook
Dim ws As Worksheet

    Set tb = ThisWorkbook
   
     For Each wb In Application.Workbooks
      For Each ws In ThisWorkbook.Worksheets
     
        If wb.Name Like "Patcher*" And wb.Name <> tb.Name Then
            
             lastRw2 = wb.Sheets("Import").Range("A" & Rows.Count).End(xlUp).Row
             lastRw1 = ws.Range("A" & Rows.Count).End(xlUp).Row
        End If
        For nxtRw = 1 To lastRw2
            With ws.Range("A1:A" & lastRw1)
                      Set m = .Find(wb.Sheets("Import").Range("A" & nxtRw), LookIn:=xlValues, lookat:=xlWhole)
                            If Not m Is Nothing Then
                                 wb.Sheets("Import").Range("B" & nxtRw & ":O" & nxtRw).Copy _
                               Destination:=ws.Range("B" & m.Row)
                       
                     End If
             End With
         Next
         Next ws
    Next wb
            
End Sub