Copy sheets....and page setup

[GustavBA]

Hi all

I have a problem I hope you can help me with. I have fond some code helping me with copying all the sheets from one workbook into a new one. I am only copying values though. This is done because the workbook should be distributed and i dont want all my formolas in it.

Now I would very much like the page setup for each sheet including header, footer etc. to be copied to the new workbook. Is that possible?

One more thing. I would also like the sheets in the new workbook to have the same name as in the original workbook.

Here is my code until now:

Sub CopySheetsValues()
Dim ThisBookSheets As Long
Dim OldNumSheets As Long
Dim i As Long
Dim ThisWorkbookName As String
OldNumSheets = Application.SheetsInNewWorkbook
ThisBookSheets = ThisWorkbook.Worksheets.Count
ThisWorkbookName = ThisWorkbook.Name
' Add new workbook with as many sheets as are in the current workbook
Application.SheetsInNewWorkbook = ThisBookSheets
Workbooks.Add

For i = 1 To ThisBookSheets
Workbooks(ThisWorkbookName).Sheets(i).Cells.Copy
With Sheets(i).Cells
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Next i
Application.SheetsInNewWorkbook = OldNumSheets
End Sub

 

[Andrew Poulsom]

Try copying the sheets, then removing the formulas:

Sub Test()
    Dim i As Integer
    ThisWorkbook.Worksheets.Copy
    With ActiveWorkbook
        For i = 1 To .Worksheets.Count
            With .Worksheets(i)
                .Cells.Copy
                .Range("A1").PasteSpecial Paste:=xlValues
            End With
        Next i
    End With
End Sub

 

[GustavBA]

This code works for me. With one exception.

Everytime I succeed to copy a sheet into a new workbook it changes my background color from white to purple
Any idea what I can do to keep the original coloring?

 

[Andrew Poulsom]

That's because the PasteSpecial method selects the cells. Try:

Sub Test()
    Dim i As Integer
    ThisWorkbook.Worksheets.Copy
    With ActiveWorkbook
        For i = 1 To .Worksheets.Count
            With .Worksheets(i)
                .Activate
                .Cells.Copy
                With .Range("A1")
                    .PasteSpecial Paste:=xlValues
                    .Select
                End With
                Application.CutCopyMode = False
            End With
        Next i
    End With
End Sub

 

[GustavBA]

Sorry no. still purple.
Actually If I do a Ctrl+C - Ctrl+V with one of the sheets from the original workbook to a new one then.....PURPLE. I can only make a PasteSpecial - values to a new workbook but thats insufficient.
If I make a copy/paste of sheets within the original workbook then everything is fine.

 

[Andrew Poulsom]

The cells in the new workbook aren't purple when I run the code I just posted. Are they for you?

 

[GustavBA]

Unfornunately yes. Still purple.

I can mail you an excample if you like. I cant attach the sheet here as this is a reply.