VBA loop to collect data from all sheets

[CalRich1023]

Hello,

I need to search through all the sheets in my workbook and gather data from a range of cells, and return that to a "Master" sheet. The range will run from cells "J9:M9", but will vary in amount of rows for each sheet (maybe 1 row, maybe 100+ rows). Obviously I'd like to omit searching on the "Master" sheet also.

Could anybody help me with this?

 

[CalRich1023]

Try changing this line

Lastrowa = .Cells(Rows.Count, "J").End(xlUp).Row

to

Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row

It says:

Runtime Error 91:
Object variable or With Block Variable not set.

 

[Fluff]

Do you have any sheets that might have nothing in col J, other than a formula that returns ""

 

[CalRich1023]

Do you have any sheets that might have nothing in col J, other than a formula that returns ""

Yes, that was going to be my next step in this process is skipping those sheets. Is that what could cause this problem?

 

[CalRich1023]

This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.

Upon further thought, would it be possible to build this so that it only takes data above a certain number? As I mentioned, the first parameter I'm looking at is an account number, which are all above 50000. So could it build built saying that, "If column J > 50000, then retrieve/copy data from columns K:M?

 

[Fluff]

How about

Sub Copy_My_Range()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Range
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 2 To Sheets.Count
    Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1

    With Sheets(i)
         Set Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)
         If Not Lastrowa Is Nothing Then
            .Range("J9:M" & Lastrowa.Row).Copy Sheets("Master").Cells(Lastrow, 1)
         End If
    End With
Next
Application.ScreenUpdating = True
End Sub

 

[CalRich1023]

How about

Sub Copy_My_Range()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Range
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 2 To Sheets.Count
    Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1

    With Sheets(i)
         Set Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)
         If Not Lastrowa Is Nothing Then
            .Range("J9:M" & Lastrowa.Row).Copy Sheets("Master").Cells(Lastrow, 1)
         End If
    End With
Next
Application.ScreenUpdating = True
End Sub

This works perfectly, however I cannot seem to get it to skip the sheets I need skipped. This is what I modified and it still seems to pull data from these sheets. What did I do wrong?

Sub Copy_My_Range()

Application.ScreenUpdating = False
Worksheets("MASTER").Range("A1:H1000").Clear
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Range
Dim Ws As Worksheet

Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
    For i = 2 To Sheets.Count
  
        Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
  
        With Sheets(i)
          For Each Ws In Worksheets
                If Ws.Name <> "SEARCH" And Ws.Name <> "ACCT #'S" And Ws.Name <> "DATA" And _
                    Ws.Name <> "Table Of Contents" And Ws.Name <> "COPY TEMPLATE" _
                    And Ws.Name <> "NOTES" And Ws.Name <> "MASTER" Then      '''SKIP THESE SHEETS
                  
                Set Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)
                  
                    If Not Lastrowa Is Nothing Then
                        .Range("J9:M" & Lastrowa.Row).Copy Sheets("MASTER").Cells(Lastrow, 1)
                    End If
                End If
            Next Ws
        End With
    Next

End Sub

 

[Fluff]

Try it like

Sub Copy_My_Range()

Application.ScreenUpdating = False
Worksheets("MASTER").Range("A1:H1000").Clear
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Range

Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
    For i = 2 To Sheets.Count
  
        Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
  
        With Sheets(i)
          
                If .Name <> "SEARCH" And .Name <> "ACCT #'S" And .Name <> "DATA" And _
                    .Name <> "Table Of Contents" And .Name <> "COPY TEMPLATE" _
                    And .Name <> "NOTES" And .Name <> "MASTER" Then      '''SKIP THESE SHEETS
                  
                Set Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)
                  
                    If Not Lastrowa Is Nothing Then
                        .Range("J9:M" & Lastrowa.Row).Copy Sheets("MASTER").Cells(Lastrow, 1)
                    End If
                End If
        End With
    Next

End Sub

 

[CalRich1023]

Try it like

Sub Copy_My_Range()

Application.ScreenUpdating = False
Worksheets("MASTER").Range("A1:H1000").Clear
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Range

Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1

    For i = 2 To Sheets.Count
 
        Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
        With Sheets(i)
         
                If .Name <> "SEARCH" And .Name <> "ACCT #'S" And .Name <> "DATA" And _
                    .Name <> "Table Of Contents" And .Name <> "COPY TEMPLATE" _
                    And .Name <> "NOTES" And .Name <> "MASTER" Then      '''SKIP THESE SHEETS
                 
                Set Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)
                 
                    If Not Lastrowa Is Nothing Then
                        .Range("J9:M" & Lastrowa.Row).Copy Sheets("MASTER").Cells(Lastrow, 1)
                    End If
                End If
        End With
    Next

End Sub

THIS WORKS PERFECTLY! THANK YOU SO MUCH AGAIN!

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[My Aswer Is This]

I like using select case like this:

Sub Copy_My_Range()
'Modified  4/4/2021  12:38:04 AM  EDT
Application.ScreenUpdating = False
Worksheets("MASTER").Range("A1:H1000").Clear
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Range

Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
    For i = 2 To Sheets.Count
  
        Lastrow = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row + 1
  
        With Sheets(i)
            Select Case Sheets(i).Name
                    Case "SEARCH", "ACCT #'S", "DATA", "Table Of Contents", "COPY TEMPLATE", "NOTES", "MASTER"
                    'Do Nothing
                  
                  Case Else
                Set Lastrowa = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)
                  
                    If Not Lastrowa Is Nothing Then
                        .Range("J9:M" & Lastrowa.Row).Copy Sheets("MASTER").Cells(Lastrow, 1)
                    End If
                End Select
        End With
    Next

End Sub