Formatting multiple copied sheets in macro

[swilliams]

I have a file with a macro that creates a new sheet named New Record. We use this new sheet to enter data and then rename the sheet 2010Q1, 2010Q2 etc to represent the year and current quarter. I also have a macro that is capable of coping anyone of the sheets and/or multiple sheets (depending on which tab I want to copy at that time) and exports them to new workbook. The macro reformats the first sheet but not multiple sheets. How can I get it to format the additional sheets selected after the first sheet? Below is what I have so far:

Thanks,

[swilliams]

To help clarify the questions, I want to export multiple sheets and format them upon export. The code above will allow me to export multiple sheets, but only reformats the first. I need to do the exact same format for all sheets.

Thanks,

[JBeaucaire]

Please edit your original post above and put code tags on your code, as shown in my signature. I think I can tweak that macro for you.

[royUK]

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

[swilliams]

 
Option Explicit

Sub CopySelectedSheets()
Dim buf As String
Dim buf2 As String
Dim ws As Worksheet
Dim CurrSht As Worksheet
Dim ShtNum As Long
Dim ScndSht As Boolean
Dim NewWB As Workbook

Set CurrSht = ActiveSheet

For Each ws In Worksheets
If buf = "" Then
buf = ws.Index & " - " & ws.Name
ElseIf Len(buf) > 45 Then
If Len(buf2) > 0 Then
buf2 = buf2 & Chr(10) & buf
Else
buf2 = buf
End If
buf = ws.Index & " - " & ws.Name
Else
buf = buf & " " & ws.Index & " - " & ws.Name
End If
Next ws

Do
ShtNum = Application.InputBox("Please enter a sheet number to copy:" _
& vbLf & buf2 & vbLf & buf, "Select a sheet", 0, Type:=1)
If ShtNum = 0 Then Exit Do
Sheets(ShtNum).Select (Not ScndSht)
ScndSht = True
Loop

ActiveWindow.SelectedSheets.Copy
Set NewWB = ActiveWorkbook
ThisWorkbook.Activate
CurrSht.Select
NewWB.Activate
Set NewWB = Nothing


Range("B21:B77").Select
Selection.Delete Shift:=xlToLeft
Range("G21:G77").Select
Selection.Delete Shift:=xlToLeft
Range("E21:E69").Select
Selection.Cut
Range("F21").Select
ActiveSheet.Paste
Range("E20").Select
Selection.Copy
Range("E21:E69").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-3
Columns("D:D").ColumnWidth = 23.86
ActiveWindow.SmallScroll Down:=-6
Columns("D:D").ColumnWidth = 27.29
Range("R21:R77").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("S21:S77").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("R20").Select
Selection.Copy
Range("R22:S65").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWindow.SmallScroll Down:=-57
Columns("E:E").ColumnWidth = 11.29
ActiveWindow.SmallScroll Down:=-24
Columns("D:D").ColumnWidth = 35.29
ActiveWindow.SmallScroll Down:=-30

End Sub

[JBeaucaire]

As long as you delete that code from post #1 (which is still incorrectly posted), we're good.

[JBeaucaire]

Try this:

Option Explicit

Sub CopySelectedSheets()
Dim buf     As String
Dim buf2    As String
Dim ws      As Worksheet
Dim CurrSht As Worksheet
Dim ShtNum  As Long
Dim ScndSht As Boolean
Dim NewWB   As Workbook

Set CurrSht = ActiveSheet

For Each ws In Worksheets
    If buf = "" Then
        buf = ws.Index & " - " & ws.Name
    ElseIf Len(buf) > 45 Then
        If Len(buf2) > 0 Then
            buf2 = buf2 & Chr(10) & buf
        Else
            buf2 = buf
        End If
        buf = ws.Index & " - " & ws.Name
    Else
        buf = buf & "     " & ws.Index & " - " & ws.Name
    End If
Next ws

Do
    ShtNum = Application.InputBox("Please enter a sheet number to copy:" _
                & vbLf & buf2 & vbLf & buf, "Select a sheet", 0, Type:=1)
    If ShtNum = 0 Then Exit Do
    Sheets(ShtNum).Select (Not ScndSht)
    ScndSht = True
Loop

ActiveWindow.SelectedSheets.Copy
Set NewWB = ActiveWorkbook
ThisWorkbook.Activate
CurrSht.Select
NewWB.Activate
Set NewWB = Nothing
 
'Format new workbook
Application.ScreenUpdating = False

    For Each ws In ActiveWorkbook.Worksheets
        ws.Range("B21:B77").Delete Shift:=xlToLeft
        ws.Range("G21:G77").Delete Shift:=xlToLeft
        ws.Range("E21:E69").Cut ws.Range("F21")
        ws.Range("E20").Copy
        ws.Range("E21:E69").PasteSpecial Paste:=xlPasteFormats
        ws.Range("R21:R77").Insert Shift:=xlToRight, _
                CopyOrigin:=xlFormatFromLeftOrAbove
        ws.Range("S21:S77").Insert Shift:=xlToRight, _
                CopyOrigin:=xlFormatFromLeftOrAbove
        ws.Range("R20").Copy
        ws.Range("R22:S65").PasteSpecial Paste:=xlPasteFormats
        ws.Columns("D:D").ColumnWidth = 35.29
    Next ws

Application.ScreenUpdating = True
End Sub