Hi

I would like to make a new sheet from a selection with keeping source formatting. And sheet names should increasse one by one.

Actually I did what I ask. But couldnt make new sheets to keep source formating and coloumn width




Sub Copy_Rows()

Dim wsNew As Worksheet, wsSrc As Worksheet, i As Long, rngSrc As Range, strname As String

Application.ScreenUpdating = False

i = Sheets.Count

'test to see that a range of cells is selected before proceeding
If Selection.Cells.Count < 2 Then
Exit Sub
Else
Set rngSrc = Selection
strname = ActiveSheet.Name
End If

Set wsSrc = Worksheets(strname) '("Sheet1")
Set wsNew = Worksheets.Add(after:=Sheets(i))

i = i + 1
wsNew.Name = "Copy_" & i

rngSrc.Copy Worksheets("Copy_" & i).Range("A2")

'Worksheets("Sheet1").Range("A1").EntireRow.Copy Worksheets("Copy_" & i).Range("A1")
Worksheets(strname).Range("A1").EntireRow.Copy Worksheets("Copy_" & i).Range("A1")

With Worksheets("Copy_" & i)

.Range("A1").CurrentRegion.Columns.AutoFit
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

Set rngSrc = Nothing
Set wsSrc = Nothing
Set wsNew = Nothing

End Sub