Looping through workbook

[Bagsy]

Can anybody please help me with this code
I am trying to loop through all the worksheets in the workbook, with the exception of the following sheets.
("Validation Sheet", "Control", "Summary", "Storage", "Job Sheet")
Then copy & paste these cells from each sheet in the workbook.
“D4” and paste on summary sheet column B65536.End(xlup)
“D6” and paste on summary sheet column D65536.End(xlup)]
“I6” and paste on summary sheet column E65536.End(xlup)
“L4” and paste on summary sheet column C65536.End(xlup)
“E30” and paste on summary sheet column F65536.End(xlup)
“E32” and paste on summary sheet column H65536.End(xlup)
“T32” and paste on summary sheet column G65536.End(xlup)

This needs to be code as the No. & name of the worksheets is generated by code from a list which will change.
I have taken part of some code by Erik Van Geit and modified it but I cannot get it to work. I get an error Select method of range class failed
on this line
and sh.Range("D4").Select

I would be eternally grateful if anybody can point me in the right direction.
Code below


Sub Complete_SummarySheet2()
'Loop through sheets except those hardcoded
Dim wb As Workbook
Dim CurrentSheet As Worksheet
Set CurrentSheet = ActiveSheet
Set wkbk = ActiveWorkbook
Dim SheetsArray As Variant
Dim sh As Worksheet
Dim Range As Range
For Each sh In ThisWorkbook.Worksheets

Application.ScreenUpdating = False
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
SheetsArray = Array("Validation Sheet", "Control", "Summary", "Storage", "Job Sheet")

If IsError(Application.Match(sh.Name, SheetsArray, 0)) Then


sh.Range("D4").Select
Selection.Copy Destination:=Summary.Rows(BRow)("B65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

sh.Range("D6").Select
Application.CutCopyMode = False
Selection.Copy Destination:=Summary.Rows(DRow)("D65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

sh.Range("I6").Select
Application.CutCopyMode = False
Selection.Copy Destination:=Summary.Rows(ERow)("E65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

sh.Range("L4").Select
Application.CutCopyMode = False
Selection.Copy Destination:=Summary.Rows(CRow)("C65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

sh.Range("E30").Select
Application.CutCopyMode = False
Selection.Copy Destination:=Summary.Rows(FRow)("F65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

sh.Range("E32").Select
Application.CutCopyMode = False
Selection.Copy Destination:=Summary.Rows(HRow)("H65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

sh.Range("T32").Select
Application.CutCopyMode = False
Selection.Copy Destination:=Summary.Rows(GRow)("G65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A2").Select
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
CurrentSheet.Select
Application.ScreenUpdating = True

End If
Next sh

End Sub

 

[Norie]

Try this.

Sub Complete_SummarySheet2()
'Loop through sheets except those hardcoded
Dim wb As Workbook
Dim CurrentSheet As Worksheet
Dim SheetsArray As Variant
Dim sh As Worksheet
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    Set CurrentSheet = ActiveSheet
    Set wkbk = ActiveWorkbook
    
    For Each sh In ThisWorkbook.Worksheets
    
        Select Case sh.Name
            Case "Validation Sheet", "Control", "Summary", "Storage", "Job Sheet"
                ' do nothing
            Case Else
                sh.Range("D4").Copy
                Worksheets("Summary").Range("B65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
                sh.Range("D6").Copy
                Worksheets("Summary").Range("D65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
                sh.Range("I6").Copy
                Worksheets("Summary").Range("E65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
                sh.Range("L4").Copy
                Worksheets("Summary").Range("C65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
                sh.Range("E30").Copy
                Worksheets("Summary").Range("F65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
                sh.Range("E32").Copy
                Worksheets("Summary").Range("H65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
                sh.Range("T32").Select
                Worksheets("Summary").Range("G65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
        End Select

    Next sh

    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

 

[Bagsy]

Norrie
Thats great
Thanks very much