VBA loop through worksheets then copy

[PB7]

Hello all,

I have an Excel workbook with up to 100 sheets.

With VBA, I just want loop through all the tabs, and copy worksheets to other files with the same name as all the sheets.

For example, a sheet name could be "123456789 P&L", and I just want to copy that to an exisiting file named 123456789.xlsx, as a new sheet tab.

I have taken multiple shots at this, to no avail. Below is non-successful code. Any feedback would be most appreciated. An accountant by trade, and I'm at my VBA ceiling right now. Thanks in advance.


Sub CopySheets9()
Dim wbTO As Workbook, wbFrom As Workbook
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim FileName As String
Set wbFrom = ThisWorkbook

Application.DisplayAlerts = False

With wbFrom
j = .Worksheets.Count
For k = 1 To j

If wbFrom.Worksheets(k).Name Like "500*" Then
Set FileName = Left(wbFrom.Worksheets(k).Name, 9)

Set wbTO = Worbooks.Open("E:\TPL VBA Project\" & "FileName" & ."xlsx")
wbFrom.Sheets(k).Copy After:=wbTO.Sheets("Sheet1")

wbTO.SaveAs ("E:\TPL VBA Project\wbTO")
End If
Next

End With

Application.DisplayAlerts = True

End Sub

 

[John_w]

Could you clarify some things because some questions arise from your description and your code.

1. "For example, a sheet name could be "123456789 P&L", and I just want to copy that to an exisiting file named 123456789.xlsx, as a new sheet tab."

Is the existing file always the first 9 characters of the sheet name? The Left(wbFrom.Worksheets(k).Name, 9) in your code.

2. But, you have:

If wbFrom.Worksheets(k).Name Like "500*" Then

which means copy the sheet only if its name starts with 500, which doesn't match your 123456789 example. Do you want to copy the sheet only if its name starts with 500?

3. "wbFrom.Sheets(k).Copy After:=wbTO.Sheets("Sheet1")"

Does the existing workbook always contain a sheet called Sheet1?

4. "wbTO.SaveAs ("E:\TPL VBA Project\wbTO")"

Do you want to save the modified workbook (with the new sheet copied to it) in a different folder to the original workbook? Or is the wbTo part of the folder path a mistake?

 

[PB7]

John, clarifications per your points:

1) The wbFrom file name is Total Backup, but its sheets are many, all beginning with different cost centers with a 9 digit format.

2) Right, the cost centers all are like 500xxxxxx...my example of 123456789 was thus bad....the example was just easy to type out.
My bad, wasn't careful in the example.

3) The existing workbook may not have a Sheet1, but the destination workbook, wbTO, will always have a Sheet1.

4) The E:\TPL VBA Project\ folder path is where "shells" of the files with tabs to be added, already exist. For example, there is a blank file named 500123456.xlsx on that path, waiting for any worksheet tab in the existing beginning with 500123456 to be added.

One aspect of accounting, its basically 2+2, but our environment has about a million excel files all over the place. Sorry this was so complex.
Thanks for the nice response.

 

[John_w]

Thanks for clarifying. Try this on a test folder containing the workbook 'shells', as shown in the code.

Sub CopySheets()

    Dim WorkbookShellsFolder As String
    Dim ws As Worksheet
    Dim FileName As String
    
    WorkbookShellsFolder = "E:\TPL VBA Project TEST\"
     
    If Right(WorkbookShellsFolder, 1) <> "\" Then WorkbookShellsFolder = WorkbookShellsFolder & "\"
    
    For Each ws In ThisWorkbook.Worksheets
        If Left(ws.Name, 3) = "500" Then
            FileName = Left(ws.Name, 9) & ".xls"
            If Dir(WorkbookShellsFolder & FileName) <> "" Then
                Workbooks.Open WorkbookShellsFolder & FileName
                ws.Copy after:=ActiveWorkbook.Sheets("Sheet1")
                ActiveWorkbook.Close savechanges:=True
            End If
        End If
    Next
            
End Sub

 

[PB7]

John w,

Your code worked like a champ, very first time! Unbelievable!

I had tried at least 5 different approaches, non successful.

Thanks for all the help!

 

[John_w]

Hi, I'm glad it worked. Just noticed that your example file is .xlsx, so you might want to change:

FileName = Left(ws.Name, 9) & ".xls"

to:

FileName = Left(ws.Name, 9) & ".xlsx"

to keep the XML file format.