Repeating Code for Multiple worksheet

[MyFlight]

Is there a simple way to run code on Multiple worksheets?
I have a workbook with 12 worksheets in it.
One worksheet named Sheet1, the rest are Named:
"Hardware", "Hardware (2)", "Hardware (3)", etc..

I need to run the following on each of the HARDWARE tabs:
Range("N1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("O1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("P1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("Q1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("S1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("T1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("U1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Range("V1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"


Any suggestions?

 

[Bong]

maybe something like:

for each s in thisWorkbook.sheets
 if (instr(1,s.name,"Hardware")=1) then
........

_________________
Bob Rashkin

 

[JerryKlmns]

Take a look at the For ... Next loop and apply it by changing the Range object each time. An array of worksheets names will help.

Dim myWorkseheets(11) As String
Dim iCount as Integer
myWorkseheets(0) = "Sheet1"
myWorkseheets(1) = "Hardware"
...
myWorkseheets(11) = "Hardware(11)"

For iCount = 0 to 11
 Worksheets(myWorkseheets(iCount)).Range("N1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
...
Next iCount

 

[MyFlight]

Thank you,

Any Idea why this only works for the First Worksheet (Hardware)?


Sub DupSheets()

Dim myWorkseheets(11) As String
Dim SAVESTR(11) As String
Dim iCount As Integer
Dim myRange As Range
Dim cell As Range
Dim delRange As Range
SAVESTR(1) = Worksheets("Sheet1").Range("B2").Value
SAVESTR(2) = Worksheets("Sheet1").Range("B3").Value
SAVESTR(3) = Worksheets("Sheet1").Range("B4").Value
SAVESTR(4) = Worksheets("Sheet1").Range("B5").Value
SAVESTR(5) = Worksheets("Sheet1").Range("B6").Value
SAVESTR(6) = Worksheets("Sheet1").Range("B7").Value
SAVESTR(7) = Worksheets("Sheet1").Range("B8").Value
SAVESTR(8) = Worksheets("Sheet1").Range("B9").Value
SAVESTR(9) = Worksheets("Sheet1").Range("B10").Value
SAVESTR(10) = Worksheets("Sheet1").Range("B11").Value
SAVESTR(11) = Worksheets("Sheet1").Range("B12").Value
myWorkseheets(0) = "Sheet1"
myWorkseheets(1) = "Hardware"
myWorkseheets(2) = "Hardware (2)"
myWorkseheets(2) = "Hardware (3)"
myWorkseheets(2) = "Hardware (4)"
myWorkseheets(2) = "Hardware (5)"
myWorkseheets(2) = "Hardware (6)"
myWorkseheets(2) = "Hardware (7)"
myWorkseheets(2) = "Hardware (8)"
myWorkseheets(2) = "Hardware (9)"
myWorkseheets(2) = "Hardware (10)"
myWorkseheets(11) = "Hardware (11)"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Windows("9006 Port Report.xls").Activate
For iCount = 0 To 11
Worksheets(myWorkseheets(iCount)).Select
Worksheets(myWorkseheets(iCount)).Columns("I:I").Select
On Error Resume Next
Selection.Find(What:=SAVESTR(iCount), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Worksheets(myWorkseheets(iCount)).Range("I1").Resize(Range( _
"I" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR(iCount) Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
Worksheets(myWorkseheets(iCount)).Range("B1").Select
Selection.EntireRow.Insert
Worksheets(myWorkseheets(iCount)).Range("N1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("O1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("P1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("Q1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("R1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("S1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("T1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("U1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("V1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("W1").FormulaR1C1 = "=SUM(R[1]C:R[500]C)"
Else
Columns("A:A").ColumnWidth = 2
End If
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
ChDir "C:\Temp Data Files\Reconfigured Data"
ActiveWorkbook.SaveAs Filename:="C:\Temp Data Files\Reconfigured Data\9006 Port Report.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Sheets("Hardware").Select
Next iCount
Application.ScreenUpdating = False
End Sub


You assistance is really appreciated.

 

[JerryKlmns]

Some improvements
For iCount =1 to 11
SAVESTR(iCount)=Worksheets("Sheet1").Range("B" & iCount).Value
Next iCount

You have wrong array indexing
myWorkseheets(2) = "Hardware (4)"
and maybe renameing the sheet to Hardware4?