copy range and paste to new worksheet

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

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 wrote:
>
> 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

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.

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 wrote:
>
> 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

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

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

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