You could use the second version of that code (the one that looped through the
columns) to loop through the rows.

Option Explicit
Sub Format_All_Worksheets()
Dim sh As Worksheet
Dim NewSh As Worksheet
Dim NewWkbk As Workbook
Dim iCol As Long
Dim iRow As Long

Set NewWkbk = Workbooks.Add(1) 'single sheet
NewWkbk.Worksheets(1).Name = "Deletemelater"

For Each sh In ThisWorkbook.Worksheets
Set NewSh = NewWkbk.Worksheets.Add
sh.Range("A19:G89").Cut _
Destination:=NewSh.Range("a1")
For iCol = 1 To 7
NewSh.Columns(iCol).ColumnWidth = sh.Columns(iCol).ColumnWidth
Next iCol
For iRow = 1 To 71 '19 to 89
NewSh.Rows(iRow).RowHeight = sh.Rows(iRow + 18).RowHeight
Next iRow
NewSh.Name = sh.Name
Next sh

Application.DisplayAlerts = False
NewWkbk.Worksheets("deletemelater").Delete
Application.DisplayAlerts = True

End Sub

Moon wrote:

Hi Dave,
Thanks, that worked although the rows didnt get formatted. I tried
Newsh.Range("a:g").PasteSpecial Paste:=xlPasteFormats but that copied
all formats including highlights on certain rows. I guess I could
change the color back in the copied sheet but is there a way to format
the columns and rows?
Thanks...Moon

--

Dave Peterson