Copy sheet and preserve formatting

[Shadkng]

I am using the below line of code to repeatedly copy a sheet over another sheet called "FINALORDER". But the formatting is not getting copied as I lose the column widths. What additional code do I need to accomplish this? Thanks

Sheets(Result).UsedRange.Copy Sheets("FINALORDER").Cells(1, 1)

 

[KKaren]

For the column width, I believe the below should work:

Sheets("Result").UsedRange.Copy
    Sheets("FINALORDER").Cells(1, 1).PasteSpecial xlPasteColumnWidths

 

[Michael M]

USe

Sub MM1()
Sheets("Result").UsedRange.Copy
With Sheets("FINALORDER")
    .Cells(1, 1).PasteSpecial xlPasteAll
    .Cells(1, 1).PasteSpecial xlPasteColumnWidths
End With
End Sub

 

[Shadkng]

Hi I inserted your code into mine - see below, but I get a runtime error 9 and subscript out of range. The line "Sheets("Result").UsedRange.Copy" is hi-lighted with the error. Thanks

Sub COPY_SHEET_TO_FINALORDER()
Dim response As Integer
Dim Result As String
Dim ws As Worksheet

Result = InputBox("ENTER THE SHEET NAME YOU WANT TO COPY.")
If Result = "" Then Exit Sub

'check if Result exists
On Error Resume Next 'suppress error message if sheet doesn't exist
Set ws = Sheets(Result)
On Error GoTo 0 're-enable error notification

If ws Is Nothing Then
MsgBox "Sorry, there was no sheet " & Result & " found."
Exit Sub
Else
response = MsgBox("You are about to copy sheet" & Result & " to FINALORDER" & vbLf & _
"Select *YES* to continue or *NO* to quit.", vbYesNo)

If response <> vbYes Then Exit Sub
End If

Application.CopyObjectsWithCells = False

Sheets("Result").UsedRange.Copy
With Sheets("FINALORDER")
.Cells(1, 1).PasteSpecial xlPasteAll
.Cells(1, 1).PasteSpecial xlPasteColumnWidths
End With

End Sub

 

[My Aswer Is This]

Why not just copy the whole sheet all at once
Try this:

Sub Copy_Sheet()
'Modified  12/25/2018  11:40:55 PM  EST
Sheets("Result").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "FINALORDER"
End Sub

 

[MARK858]

Hi I inserted your code into mine - see below, but I get a runtime error 9 and subscript out of range. The line "Sheets("Result").UsedRange.Copy" is hi-lighted with the error. Thanks

Remove the quotes around "Result" as Result is a variable not a sheet name.

Edit:
Or change

Sheets("Result").UsedRange.Copy

to

ws.UsedRange.Copy

as you are also assigning the variable string to a worksheet variable in the code (no idea why you are doing both).

 

[Peter h]

Hi I inserted your code into mine - see below, but I get a runtime error 9 and subscript out of range. The line "Sheets("Result").UsedRange.Copy" is hi-lighted with the error. Thanks

Sub COPY_SHEET_TO_FINALORDER()
Dim response As Integer
Dim Result As String
Dim ws As Worksheet

Result = InputBox("ENTER THE SHEET NAME YOU WANT TO COPY.")
If Result = "" Then Exit Sub

'check if Result exists
On Error Resume Next 'suppress error message if sheet doesn't exist
Set ws = Sheets(Result)
On Error GoTo 0 're-enable error notification

If ws Is Nothing Then
MsgBox "Sorry, there was no sheet " & Result & " found."
Exit Sub
Else
response = MsgBox("You are about to copy sheet" & Result & " to FINALORDER" & vbLf & _
"Select *YES* to continue or *NO* to quit.", vbYesNo)

If response <> vbYes Then Exit Sub
End If

Application.CopyObjectsWithCells = False

Sheets("Result").UsedRange.Copy
With Sheets("FINALORDER")
.Cells(1, 1).PasteSpecial xlPasteAll
.Cells(1, 1).PasteSpecial xlPasteColumnWidths
End With

End Sub

Sheets("Result") should not be in quotes. It should be Sheets(Result)

 

[Shadkng]

That worked thanks. One more thing...after it runs the "FINALORDER" sheet is darkened after the paste. That didn't happen before. Is there a way to get rid of that without having to click on a cell? Thanks

 

[Peter h]

That worked thanks. One more thing...after it runs the "FINALORDER" sheet is darkened after the paste. That didn't happen before. Is there a way to get rid of that without having to click on a cell? Thanks

You could put after the ".Cells(1, 1).PasteSpecial xlPasteColumnWidths" line

.Cells(1, 1).Select