copy range and paste to new worksheet

[Moon]

Hi All,
I'm stuck with my code to copy a range of cells and insert into new
worksheet with the name of the old worksheet. Also, I want to keep the
format of the original range of cells but not sure how to do so. Can
anyone help.
Thanks,Moon

Sub Format_All_Worksheets()
Dim sh As Worksheet
Dim Newsh As Worksheet


For Each sh In ThisWorkbook.Worksheets


Set Newsh = ThisWorkbook.Worksheets.Add

With sh.Range("A19:G89")

sh.Range("A19:G89").Cut Newsh.Cells
Newsh.Name = sh.Name


End With


Next sh
End Sub

 

[Dave Peterson]

If you add a new worksheet to the same workbook, then it can't have the same
name as a worksheet already in that workbook.

If you're trying to create a new workbook with lots of worksheets (with the same
name) but only A19:G89 copied, maybe something like:

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

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")
NewSh.Name = sh.Name
Next sh

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

End Sub

 

[Moon]

Hi Dave,
Ah, that makes sense; not having same worksheet names in same workbook.
Also, I was wondering how to retain the format of the copied range
after it is pasted onto a new worksheet. The column widths are narrowed
when it is pasted onto the new worksheet.

 

[Dave Peterson]

If you're using xl2k or higher, you can copy|paste special|columnwidths.

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

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")
sh.Range("A:g").Copy
NewSh.Range("a:g").PasteSpecial Paste:=8 'xlPasteColumnWidths
NewSh.Name = sh.Name
Next sh

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

End Sub

if you're using xl97 (actually any version):

Option Explicit
Sub Format_All_Worksheets()
Dim sh As Worksheet
Dim NewSh As Worksheet
Dim NewWkbk As Workbook
Dim iCol 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
NewSh.Name = sh.Name
Next sh

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

End Sub

 

[Moon]

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]

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]

Hi Dave,
Thanks for all your help. That worked perfectly!
Moon