vba code to save an existing workbook with a new name

[Reddog94]

I have this code that, in an existing open workbook (let's call it "Template"), looks for any tabs that have a name begining with "CC". For each of these tabs, it copies the tab into a new workbook, deletes any extra tabs, then saves the new workbook to my desktop.

Sub Copy_Save_CC()

Dim wb As Workbook
Dim NewBook As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb = ActiveWorkbook

For Each ws In wb.Worksheets
If UCase(Left(ws.Name, 2)) = "CC" Then
Set NewBook = Workbooks.Add
With NewBook
.Title = ws.Name
ws.Copy After:=NewBook.Worksheets("Sheet3")

For Each ws2 In NewBook.Worksheets
If ws2.Name <> ws.Name Then
ws2.Delete
End If
Next
.SaveAs Filename:="C:\Users\lmcginle\Desktop\" & ws.Name
.Close
End With
End If
Next

wb.Activate

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


I want to change this to open an existing workbook (let's call it "Template2") instead of creating a new workbook.

So:

For each tab in "Template" that starts with "CC"
Open "Template2"
Copy CC worksheet into "Template2"
Save "Template2" to my desktop, with a name that is equal to the sheet name and close.
Close "Template2"
Repeat for each tab in "Template" that begins with "CC"

I've tried a couple iterations of code but none worked. I've now spent 6 hours trying to write it myself so would like some assistance if possible. Thanks.

 

[bamblack]

This is a pretty roundabout way of doing it, but give this a shot and see if it works for you.

Sub Test()

Dim wb As Workbook
Dim ws As Worksheet
Dim myTemplate As String
Dim ThisFile As String
Dim SaveFile As String
Dim tempName As String
Dim pathName As String

pathName = "C:\Users\lmcginle\Desktop\"
tempName = "Template2.xlsx"
myTemplate = pathName & tempName
Set wb = ActiveWorkbook

For Each ws In wb.Sheets
    If UCase(Left(ws.Name, 2)) = "CC" Then
        SaveFile = ws.Name
        ThisFile = wb.Name
        Workbooks.Open (myTemplate)
        Windows(ThisFile).Activate
        ws.Copy After:=Workbooks(tempName).Sheets("Sheet3")
        Windows(tempName).Activate
        ActiveWorkbook.SaveAs Filename:=pathName & SaveFile & ".xlsx"
        ActiveWorkbook.Close
        Windows(ThisFile).Activate
    End If
Next ws

End Sub

This assumes that you have the Template2 file saved to the desktop. If not then use this

Sub Test()

Dim wb As Workbook
Dim ws As Worksheet
Dim myTemplate As String
Dim ThisFile As String
Dim SaveFile As String
Dim tempName As String
Dim pathName As String
Dim pathName2 As String

pathName = "C:\Users\lmcginle\Desktop\"
pathName2 = PATH WHERE TEMPLATE2 IS SAVED
tempName = "Template2.xlsx"
myTemplate = pathName2 & tempName
Set wb = ActiveWorkbook

For Each ws In wb.Sheets
    If UCase(Left(ws.Name, 2)) = "CC" Then
        SaveFile = ws.Name
        ThisFile = wb.Name
        Workbooks.Open (myTemplate)
        Windows(ThisFile).Activate
        ws.Copy After:=Workbooks(tempName).Sheets("Sheet3")
        Windows(tempName).Activate
        ActiveWorkbook.SaveAs Filename:=pathName & SaveFile & ".xlsx"
        ActiveWorkbook.Close
        Windows(ThisFile).Activate
    End If
Next ws

End Sub

 

[Reddog94]

No dice - telling me I have a Next without a For - but I can' t figure out where that may be. The code looks fine to me...

 

[bamblack]

Hmmm, that's odd, did everything copy over correctly? The code is working fine for me.

 

[Reddog94]

This morning I tried the code in a completely new workbook and still got the Next without For error when I ran the code in the immediate window.

I'm stumped, because there clearly is a For and Next. I can't post attachments yet unfortunately, but I did make sure to copy the code exactly as you have it written. Any other thoughts? Thanks again for the help.

 

[bamblack]

When it gives you the error message does it it highlight the "Next" in "Next ws" on the second to last line of code?

Try putting this in a new module in a new workbook and see if it does the same thing.

Sub Test()

Dim ws As Worksheet
Dim wb As Workbook

Set wb = ActiveWorkbook

For Each ws In wb.Sheets
    ws.Select
Next ws

End Sub