Help looping a macro please

[wallyxl]

Hello everyone,
I have recorded a macro and it works fine.
I have 18 sheets that are numbered 1 through to 18.
I would like this macro to loop through each sheet from 1 to 18 as I will need to extract data from each sheet about 4 times (I can change the range(D25) each time I run it.

Thank you.

Sheets("18").Select
    Range("D25").Select
    Selection.Copy
    ActiveCell.Offset(65, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-65, 2).Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(65, -3).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-62, 2).Range("A1:D7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(62, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-62, 23).Range("A1:B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(62, -19).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, -6).Range("A1:B1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1:A6").Select
    ActiveSheet.Paste
    ActiveCell.Rows("1:1").EntireRow.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(-3, 2).Range("A1:H4").Select
    Selection.Cut
    Sheets("Catchall").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Select
    Selection.End(xlUp).Select
End Sub

 

[ranman256]

Dim sht as worksheet
 
for each sht in sheets
     Sht.activate
      RunYourMacro
Next

 

[wallyxl]

Hi ranman,
What do I do with this code?
Do I place it above the macro?

 

[Joe4]

Your Macro can cleaned up to increase speed and shorten it up a bit (it is usually not necessary to select ranges to work with them in VBA, and selecting them actually slows down your code).
We can help you clean it up, but rather than trying to reverse engineer your whole code, can you just explain the steps it should be doing in plain English?

 

[Fluff]

As I just finished cleaning up the code.
This should do what your macro does & will loop through the sheets

Sub CopyPaste()
   Dim Ws As Worksheets
   
   For Each Ws In Sheets([COLOR=#0000ff]Array("1", "2", "3", "4")[/COLOR])
      With Ws
         .Range("D25").Copy .Range("D90")
         .Range("F25").Copy .Range("C90")
         .Range("E28:H34").Copy .Range("E90")
         .Range("AB28:AC34").Copy .Range("I90")
         .Range("C90:D90").Copy .Range("C91:C96")
         .Range("91:91,93:93,95:95").EntireRow.Delete
         .Range("C90:J93").Cut Sheets("Catchall").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End With
   Next Ws
End Sub

Just add the rest of the sheets to the array in blue, in the same manner

 

[wallyxl]

Hi Joe4 and Fluff,
Fluff your code looks spot on (it looks so much better like that), when I run it I get a
Run-time error '13'
Type mismatch

Just to clarify, the worksheets have just numbers as names that is 1 - 2 - 3 etc not worksheet(1), is this the problem?

 

[Fluff]

Typo on

Dim Ws As Worksheets

It should be Worksheet (singular)

 

[wallyxl]

Works a treat Fluff, once again thank you to everyone.

 

[Fluff]

Glad we could help & thanks for the feedback