Looping through workbook

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
409
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
Try this.
Code:
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

Active Member
Joined
Feb 26, 2005
Messages
409
Office Version
  1. 365
Platform
  1. Windows
Norrie
Thats great
Thanks very much
 

Forum statistics

Threads
1,136,924
Messages
5,678,598
Members
419,774
Latest member
MooseWinooski

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top