How to add a number to a name of a copied worksheet in a new workbook in VBA

Question

I have files named "A0118", "A0218"..."A1208". Each file has different number of sheets but they have same names. e.g. "A0118" has worksheets names "1", "2", "3", "X" "Y"; "A1218" has worksheets "1", "3", "Y".

I want to copy all the worksheets from each file into a new workbook and have the names of the worksheet include the name of the file so for file "A0118" i want the copied sheets to be named "0118 - 1" so add "0118 - " in front of the original sheet name.

I'm not sure how to amend the copied worksheet and I'm stuck at this line

ActiveSheet.Name = "0118 - " &

Any help would be much appriciated. Thanks Any advice on improving the existing code is also appriciated!

Sub XYZ()


Application.ScreenUpdating = False  


Dim sh As Worksheet



Workbooks.Open Filename:="C:\Users\CopyHere.xlsx"
    Set b1 = ActiveWorkbook
Workbooks.Open Filename:="C:\Users\A0118.xlsx", Password:="1", writeresPassword:="1"
    Set b2 = ActiveWorkbook

For Each sh In b2.Sheets
    sh.Copy After:=b1.Sheets(b1.Sheets.Count)
    ActiveSheet.Name = "0118 - " &
Next sh
Workbooks("A0118.xlsx").Close


' 
'
'
    
Workbooks.Open Filename:="C:\Users\A1218.xls", Password:="1", writeresPassword:="1"
    Set b13 = ActiveWorkbook
For Each sh In b13.Sheets
    sh.Copy After:=b1.Sheets(b1.Sheets.Count)
    ActiveSheet.Name = "1218 - " &
Next sh
Workbooks("A1218.xlsx").Close
 


Application.ScreenUpdating = True

End Sub

Ricardo Diaz Ricardo Diaz · Accepted Answer · 2020-12-12T13:51:13

As you need the file name to be variable, you have to loop through the files in the folder and reference them when you're assigning the sheet's names.

I put together this code (credits to thespreadsheetguru) that should be useful to learn about the process.

Some suggestions:

Name your procedure and variables to something meaningful
Indent your code (you may use www.rubberduckvba.com)
Split the logic in steps

Read the code's comments and step into it using F8 key

Adjust it with your file paths

Code:

Public Sub RenameAndCopySheets()
    ' Credits: https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder
    ' Modified by: www.ricardodiaz.co

    On Error GoTo CleanFail
    
    ' Turn off stuff
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Set destination workbook
    Dim destinationWorkbook As Workbook
    Set destinationWorkbook = Workbooks.Open(fileName:="C:\Temp\SampleExcelFiles\CopyHere.xlsx")
    
    ' Target File Extension (must include wildcard "*")
    Dim fileExtension As String
    fileExtension = "*.xls*"
    
    Dim folderPath As String
    folderPath = "C:\Temp\SampleExcelFiles\"
    
    ' Target Path with Ending Extension
    Dim fileName As String
    fileName = Dir(folderPath & fileExtension)
    
    ' Loop through each Excel file in folder
    Do While fileName <> ""
    
        ' Skip destination file
        If fileName <> destinationWorkbook.Name Then
        
        'Set variable equal to opened workbook
        Dim sourceWorkbook As Workbook
        Set sourceWorkbook = Workbooks.Open(fileName:=folderPath & fileName, Password:="1", writeresPassword:="1")
        
        'Ensure Workbook has opened before moving on to next line of code
        DoEvents
        
        ' Loop through each sheet
        Dim sourceSheet As Worksheet
        For Each sourceSheet In sourceWorkbook.Worksheets
            
            ' Copy sheet at the end
            sourceSheet.Copy After:=destinationWorkbook.Sheets(destinationWorkbook.Sheets.Count)
            
            ' Rename sheet copied (be aware that you don't have hidden sheets otherwise this process could fail)
            destinationWorkbook.Sheets(destinationWorkbook.Sheets.Count).Name = Mid(fileName, 2, 4) & " - " & sourceSheet.Name
        
        Next sourceSheet
        
        'Save and Close Workbook
        sourceWorkbook.Close SaveChanges:=False
        
        'Ensure Workbook has closed before moving on to next line of code
        DoEvents
        
        End If
        
        'Get next file name
        fileName = Dir
    Loop
    
CleanExit:
        ' Turn on stuff again
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    
CleanFail:
        MsgBox "An error occurred:" & Err.Description
        GoTo CleanExit
    
End Sub

Let me know if it works

How to add a number to a name of a copied worksheet in a new workbook in VBA

2 Answers