Object variable or with block not set error

[abdelfattah]

I got this code for @DanteAmor . I expect bring data from multiple sheet into sheet TOTAL based on match the headers in sheet TOTAL with the headers in others sheets , but it gives "Object variable or with block not set error" in this line

lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row

Sub through_all_sheets()
  Dim sh1 As Worksheet, sh As Worksheet
  Dim f As Range
  Dim j As Long, lr1 As Long, lr As Long
 
  Set sh1 = Sheets("Total")
 
  For Each sh In Sheets
    If sh.Name <> sh1.Name Then
      lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
      lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
      For j = 1 To sh.Cells(1, Columns.Count).End(1).Column
        Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
        End If
      Next
    End If
  Next
End Sub

any help to fix this error ,please?

 

[StephenCrump]

You may have a blank worksheet(s). Does this work?

Sub through_all_sheets()
 
    Dim sh1 As Worksheet, sh As Worksheet
    Dim f As Range
    Dim j As Long, lr1 As Long, lr As Long
    
    Set sh1 = Sheets("Total")
    
    For Each sh In Sheets
        If sh.Name <> sh1.Name And sh.UsedRange.Address <> "$A$1" Then
            lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
            lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
            For j = 1 To sh.Cells(1, Columns.Count).End(1).Column
                Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
                If Not f Is Nothing Then
                    sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
                End If
            Next
        End If
    Next
End Sub

 

[DanteAmor]

That is because you have a blank sheet.
Try this:

Sub through_all_sheets()
  Dim sh1 As Worksheet, sh As Worksheet
  Dim f As Range
  Dim j As Long, lr1 As Long, lr As Long
  Dim n As Variant
  
  Set sh1 = Sheets("Total")
 
  For Each sh In Sheets
    If sh.Name <> sh1.Name Then
      lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
      On Error Resume Next
      lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
      n = Err.Number
      On Error GoTo 0
      If n = 0 Then
        For j = 1 To sh.Cells(1, Columns.Count).End(1).Column
          Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
          If Not f Is Nothing Then
            sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
          End If
        Next
      End If
    End If
  Next
End Sub

 

[abdelfattah]

guys you're right . I have sheet is empty .I deleted . the error is gone, but unfortunately your code both doesn't work at all.
what's the problem?

 

[StephenCrump]

.... but unfortunately your code both doesn't work at all.
what's the problem?

I'm not sure what you mean by "doesn't work". Can you please explain in more detail?

If you have deleted any blank sheet(s), then all three codes should work identically.

 

[abdelfattah]

it doesn't show data under column which contain the header in sheet Total based on others sheets. there is no error .

 

[DanteAmor]

First, the names of the headings of all the sheets must be in row1. Also the "Total" sheet headings must be in row 1.
Second, the names of the sheet headings must match the names of the headings on the "Total" sheet.
Finally, put here a sample of one of your sheets and your "Total" sheet, where we can see the names of the headings.

 

[abdelfattah]

@DanteAmor thanks for your advices. I re-arranged data again and works , but I have some problems . based on the picture shows empty cells when run the macro repeatedly. it shouldn't be

second when run the macro continuously .it repeats copying data have already copy to the bottom I want just if there is new data then should copy to the bottom

finally I would implement the code just for sheets(sh1,sh2) not all sheets .

aa.xlsx
	A	B	C	D
2	1	A-SS1	123
3	2	A-SS2	124
4	3	A-SS3	56
5	4	A-SS4	78
6	5	A-SS5	99
7	6	A-SS6	56
8	7	A-SS7	34
9	8	A-SS8	45
10	1	A-SS1		15
11	2	A-SS2		20
12	3	A-SS3		30
13	4	A-SS4		40
14	5	A-SS5		34
15	6	A-SS6		55
16	7	A-SS7		12
17	8	A-SS8		13
18	1	A-SS1	123
19	2	A-SS2	124
20	3	A-SS3	56
21	4	A-SS4	78
22	5	A-SS5	99
23	6	A-SS6	56
24	7	A-SS7	34
25	8	A-SS8	45
26	1	A-SS1		15
27	2	A-SS2		20
28	3	A-SS3		30
29	4	A-SS4		40
30	5	A-SS5		34
31	6	A-SS6		55
32	7	A-SS7		12
33	8	A-SS8		13
Total

thanks again

 

[DanteAmor]

finally I would implement the code just for sheets(sh1,sh2) not all sheets .

Update the name of the sheets you need in this line:

Case "sh1", "sh2"

Try this:

Sub through_all_sheets()
  Dim sh1 As Worksheet, sh As Worksheet
  Dim f As Range
  Dim j As Long, lr1 As Long, lr As Long
  Dim n As Variant
  
  Set sh1 = Sheets("Total")
  sh1.Rows("2:" & Rows.Count).ClearContents
  
  For Each sh In Sheets
    Select Case sh.Name
      Case "sh1", "sh2"
        For j = 1 To sh.Cells(1, Columns.Count).End(1).Column
          lr = sh.Cells(Rows.Count, j).End(3).Row
          Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
          If Not f Is Nothing Then
            lr1 = sh1.Cells(Rows.Count, f.Column).End(3).Row + 1
            sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
          End If
        Next
    End Select
  Next
End Sub

 

[abdelfattah]

great ! yes this is exactly what I want
much appreciated professional