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

score 1 · Accepted Answer · answered Dec 12 '20 at 13:51

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

Thank you! it worked almost perfectly: 1. 'code' destinationWorkbook.Sheets(destinationWorkbook.Sheets.Count).Name = Mid(fileName, 2, 4) & " - " & sourceSheet.Name this creates an extension after the 4th letter, so the new name is "0118.xls - Name", is there a way to remove the file extension in the name? Not very important, just a preference and easier on the eye 2. it doesn't go through the files in any particular order. Is there a way to make it go in order? start with "A0118" -> "A0218" -> .....-> "A0318" — Dan, Dec 12 '20 at 16:16
1) For the file name use the left or len functions. 2) To sort the dir results, check this https://stackoverflow.com/q/4282940/1521579 — Ricardo Diaz, Dec 12 '20 at 16:35

score 0 · Answer 2 · answered Dec 12 '20 at 13:32

0

Try this:

Dim i As Integer
For Each sh In b2.Sheets
    i = 1
    sh.Copy After:=b1.Sheets(b1.Sheets.Count)
    ActiveSheet.Name = "0118 - " & b2.Sheets(i).Name
    i = i + 1
Next sh

answered Dec 12 '20 at 13:32

Toni

1,555
4
15
23

Why do you need `i`? Isn't `b2.Sheets(i)` the same as `sh` or am I missing something? – Super Symmetry Dec 12 '20 at 14:09
sh is a sheet, but i is a number, – Toni Dec 12 '20 at 15:43

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

2 Answers2