Macro to Run a Procedure Across Several Excel Worksheets - excel

Question

I'm stuck with this problem. I need to run a macro that will do the following:
Find the last line in a table on the worksheet called "Baseline".
Add a row to that table
Copy the formats and formulas (but not values) from the row above to the new row.
Repeat the process for the other worksheets (called Quarter 1, Quarter 2 etc), that have the same structure as the worksheet called Baseline.
My problem is that the process only seems to work on the first worksheet, Baseline, but not on any of the other worksheets. I wonder if the problem is the way I have tried to get the code to copy formulas and formats only.
Here is the code, just for the Baseline and Quarter 1 worksheets:
Public Sub AddRow()
On Error GoTo errhandler
Worksheets("Baseline").Activate
'Find Last Row in Service User Details
Dim rgeLastRowBaseline As Range
Set rgeLastRowBaseline = ActiveWorkbook.Worksheets("Baseline").Cells.Find("Cost")
' Select and Copy Last Row
rgeLastRowBaseline.End(xlDown).EntireRow.Select
Selection.Offset(1).EntireRow.Insert
rgeLastRowBaseline.End(xlDown).EntireRow.Select
Selection.Copy
rgeLastRowBaseline.End(xlDown).Offset(1).EntireRow.Select
rgeLastRowBaseline.End(xlDown).Offset(1).EntireRow.PasteSpecial
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.ClearContents
'Quarter 1
Worksheets("Quarter 1").Activate
Dim rgeLastRowQ1 As Range
Set rgeLastRowQ1 = ActiveWorkbook.Worksheets("Quarter 1").Cells.Find("Cost")
' Select and Copy Last Row
rgeLastRowQ1.End(xlDown).EntireRow.Select
Selection.Offset(1).EntireRow.Insert
rgeLastRowQ1.End(xlDown).EntireRow.Select
Selection.Copy
rgeLastRowQ1.End(xlDown).Offset(1).EntireRow.Select
rgeLastRowQ1.End(xlDown).Offset(1).EntireRow.PasteSpecial
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.ClearContents
Exit Sub
errhandler:
Application.CutCopyMode = False
End Sub
Does anyone have any suggestions please?
Thanks

Answer 1

You'll need to use Worksheet type variables. I did not correct your technical solutions even though I don't completely agree with selecting everything.
Sub onesheet(ws As Worksheet)
On Error GoTo errhandler
ws.Activate
Dim rgeLastRowQ1 As Range
Set rgeLastRowQ1 = ws.Cells.Find("Cost")
' Select and Copy Last Row
rgeLastRowQ1.End(xlDown).EntireRow.Select
Selection.Offset(1).EntireRow.Insert
rgeLastRowQ1.End(xlDown).EntireRow.Select
Selection.Copy
rgeLastRowQ1.End(xlDown).Offset(1).EntireRow.Select
rgeLastRowQ1.End(xlDown).Offset(1).EntireRow.PasteSpecial
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.ClearContents
Exit Sub
errhandler:
Application.CutCopyMode = False
End Sub
Sub sheetloop()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Baseline" Or ws.Name Like "Quarter*" Then Call onesheet(ws)
Next ws
End Sub