Hi,

Thanks to all who have helped with code for my workbook, I have managed to
piece it all together to perform several task with the click of a button, but
have two small glitches I hope someone can help resolve.

The last bit of code " 'copy summary from main worksheet" should copy
w1:am75 and place in same location on each of the worksheets listed. It will
do this but also copies w34:am75 and places it underneath the first copy of
w1:am75. The second portion that is copied has lines inserted at each place
a total line is inserted from code listed above. I tried several ways of
rearranging the code thinking it was something in the looping process and
nothing seems to correct it.

If anyone can please take a look and tell me what is going wrong with this
and possibly clean up code as needed, I would really appreciate the
assistance. Also, how do I make the highlight for the total rows that are
found in cols B & C extend left to A & B. I would like for it to cover the
section A:P, but this is the only code I could find that would work.

Sub Total_Bookings_WorksheetsTest2()

Dim ws As Worksheet
Dim rng As Range

For Each ws In Worksheets

Select Case ws.Name

'All sheet names listed in the case statement
'will be processed. Change the names I have
'used to your sheet names and add your
'additional sheet names separated by commas.
Case "Bk01-09", "Bk02-09"

ws.Select
'Sort selected worksheets
Range("A1:p900").Select
Selection.Sort Key1:=Range("c2"), _
Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key2:=Range("b2"), Order2:=xlAscending, _
Header:=xlYes

On Error Resume Next
'Following line references active sheet so
'do not nest inside the With/End With
Set rng = Range(Range("j2"), _
Cells(2, Columns.Count).End(xlToLeft))
On Error GoTo 0

If Not rng Is Nothing Then

With ws
'Subtotal selected sheets
.Range("j2").Subtotal _
GroupBy:=3, _
Function:=xlSum, _
TotalList:=Array(10, 11, 12), _
Replace:=False, _
PageBreaks:=False, _
SummaryBelowData:=True

.Range("j2").Subtotal _
GroupBy:=1, _
Function:=xlSum, _
TotalList:=Array(10, 11, 12), _
Replace:=False, _
PageBreaks:=False, _
SummaryBelowData:=True

.Range("j2").Subtotal _
GroupBy:=2, _
Function:=xlSum, _
TotalList:=Array(10, 11, 12), _
Replace:=False, _
PageBreaks:=False, _
SummaryBelowData:=True

'Format area for summary formulas from main sheet
.Range("w2:am75").NumberFormat = "$#,##0.00;($#,##0.00)"
.Range("w2:am75").Font.Size = 8

End With

End If
'Bold and insert row at "total" rows
Dim LastRow As Long
Dim r As Long
'Following code references active sheet so
'do not nest inside the With/End With
LastRow = Range("G" & Rows.Count).End(xlUp).Row
For r = LastRow To 2 Step -1
If InStr(1, Cells(r, 1).Value, "Total") 0 Or _
InStr(1, Cells(r, 2).Value, "Total") 0 Or _
InStr(1, Cells(r, 3).Value, "Total") 0 Or _
InStr(1, Cells(r, 4).Value, "Total") 0 Then
Range(Cells(r, 1), Cells(r, 16)).Font.Bold = True
ActiveSheet.Rows(r + 1).EntireRow.Insert
End If
Next

'Highlight "total" rows
Dim rngFound As Range
Dim strFirstAddress As String

'Search slsp (Col A) for Total rows & highlight
Set rngFound = Columns("A").Find(What:="total", _
LookAt:=xlPart, _
LookIn:=xlValues, _
MatchCase:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
rngFound.Resize(, 16).Interior.ColorIndex = 17
Set rngFound = Columns("A").FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If

'Search Class (Col B) for Total rows & highlight
Set rngFound = Columns("B").Find(What:="total", _
LookAt:=xlPart, _
LookIn:=xlValues, _
MatchCase:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
rngFound.Resize(, 15).Interior.ColorIndex = 6
Set rngFound = Columns("B").FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If

'Search Dept (Col C) for Total rows & highlight
Set rngFound = Columns("c").Find(What:="total", _
LookAt:=xlPart, _
LookIn:=xlValues, _
MatchCase:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
rngFound.Resize(, 14).Interior.ColorIndex = 23
Set rngFound = Columns("c").FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Select 'End of Case


'copy summary section from main worksheet
Dim wsrng As Range
Dim myarray()
Dim i As Long
Set wsrng = Worksheets("Bookings").Range("w1:AM75")

myarray = Array("Bk01-09", "Bk02-09")

For i = LBound(myarray) To UBound(myarray)

Worksheets(myarray(i)).Range("w1:AM75").Formula = wsrng.Formula

'replace formula with .value if you want to copy cell values
Next

Next ws

End Sub

Again, I would really appreciate the help.
Thanks in advance,
Phisaw