Perform a macro on multiple worksheets

**XL2008** · 01-06-2011, 02:57 PM

I tried to search this out on the site but couldn't seem to find an iteration that I could make enough sense out of for my use.

I have the following code and what I'd like to do is have this same code performed on 28 other worksheets in the same workbook. I'm sure I could copy and repeat the same code 28 more times, but I've got to imagine there is some way to get a macro to tab through each sheet and perform the macro.

The other sheets are named "Network 1" through "Network 28"


Sub Autonumber()

Dim LastRow As Long
LastRow = Range("J65536").End(xlUp).Row
    

Sheets("Master Disruption").Select
Range("A2").Formula = "=if(J2>0,row(A1),"""")"
Range("A2").AutoFill Destination:=Range("A2:A" & LastRow), Type:=xlFillDefault
ActiveSheet.Range("A2", ActiveSheet.Range("A2").End(xlDown)).Copy
ActiveSheet.Range("A2", ActiveSheet.Range("A2").End(xlDown)).PasteSpecial (xlPasteValues)


End Sub

Thanks in advance!

**royUK** · 01-06-2011, 03:38 PM

Try this

Option Explicit

Sub Autonumber()
    Dim ws As Worksheet
    Dim LastRow As Long

    For Each ws In ThisWorkbook.Worksheets
        With ws
            LastRow = .Range("J65536").End(xlUp).Row
            .Range("A2").Formula = "=if(J2>0,row(A1),"""")"
            .Range("A2").AutoFill Destination:=.Range("A2:A" & LastRow), Type:=xlFillDefault
            .Range("A2", .Range("A2").End(xlDown)).Copy
            .Range("A2", .Range("A2").End(xlDown)).PasteSpecial (xlPasteValues)
        End With
    Next ws
End Sub

**XL2008** · 01-06-2011, 04:09 PM

Thanks for the code. I forgot to mention one piece though. The Network 1 through Network 28 worksheets that I need to copy this to have to somehow be specifically mentioned. There are several other sheets in the workbook that I don't want this copied to.

Originally Posted by royUK

Try this

Option Explicit

Sub Autonumber()
    Dim ws As Worksheet
    Dim LastRow As Long

    For Each ws In ThisWorkbook.Worksheets
        With ws
            LastRow = .Range("J65536").End(xlUp).Row
            .Range("A2").Formula = "=if(J2>0,row(A1),"""")"
            .Range("A2").AutoFill Destination:=.Range("A2:A" & LastRow), Type:=xlFillDefault
            .Range("A2", .Range("A2").End(xlDown)).Copy
            .Range("A2", .Range("A2").End(xlDown)).PasteSpecial (xlPasteValues)
        End With
    Next ws
End Sub

**Leith Ross** · 01-06-2011, 05:50 PM

Hello XL2008,

This change will auto-number only the worksheets named "Network 1" through "Network 28".

Sub Autonumber()

  Dim LastRow As Long
  Dim ws As Worksheet
 
    For Each ws In ThisWorkbook.Worksheets
      Select Case LCase(ws.Name)
        Case "network 1" To "network 28"
          With ws
            LastRow = .Range("J65536").End(xlUp).Row
            .Range("A2").Formula = "=if(J2>0,row(A1),"""")"
            .Range("A2").AutoFill Destination:=.Range("A2:A" & LastRow), Type:=xlFillDefault
            .Range("A2", .Range("A2").End(xlDown)).Copy
            .Range("A2", .Range("A2").End(xlDown)).PasteSpecial (xlPasteValues)
          End With
      End Select
    Next ws
    
End Sub

**royUK** · 01-07-2011, 02:32 AM

Or


Sub Autonumber()
    Dim ws As Worksheet
    Dim LastRow As Long

    For Each ws In ThisWorkbook.Worksheets
        If Left(ws.Name, 7) = "Network" Then
            With ws
                LastRow = .Range("J65536").End(xlUp).Row
                .Range("A2").Formula = "=if(J2>0,row(A1),"""")"
                .Range("A2").AutoFill Destination:=.Range("A2:A" & LastRow), Type:=xlFillDefault
                .Range("A2", .Range("A2").End(xlDown)).Copy
                .Range("A2", .Range("A2").End(xlDown)).PasteSpecial (xlPasteValues)
            End With
        End If
    Next ws
End Sub