I am using two macro's. The first macro to rename the worksheet of excel files to the name of the workbook. And the second macro to merge these renamed workbooks (only containing one worksheet) into one workbook. Each renamed workbook is a separate tab in the new workbook that is created by the second macro.
Example of a name of one of the files: AA_aaa##123456789-123456789. In the rename macro I remove the last characters from the name so the worksheet is named AA_aaa. All files have different names, but all with the same format and length.
For the first macro I open each excel file, run the macro and close and save the excel file again. For the second macro I open an exmpy excel file only containing the merge macro. I run the merge macro from this file and it asks me to select the files I want to merge. The files that I want to merge need to be closed at that time.
The order of the steps that I take is:
1. I open the excel file for which I want to rename the worksheet.
2. I run the rename macro (I have another excel open that contains the macro to rename so I can select it from there).
3. I save and close the workbook with the renamed worksheet.
4. I do the same for all other excel files (I usually have around files 10 to rename at once).
5. I open an Excel file that contains the merge macro (there is no data in the excel file).
6. I run the merge macro.
7. The macro asks me to select the files I want to merge (these are the 10 files I renamed in the previous steps).
8. I select the files renamed in my first steps.
Result: I now have one file with multiple worksheets, these worksheets contain the data which was in the files I renamed, the name of each worksheet is the name of the original file!
I need to do this process about 20 times per day. Especially step 1 (renaming the worksheets) is taking a lot of time because I need to open and save each file separately. I was hoping that someone can help me combining these two macro's into one. The aim is to run 1 macro that first renames the worksheets and then merges them into one file.
These are the macro's I currently use:
Macro 1 to rename the worksheets:
Sub RenameSheet()
Dim myname
myname = Replace(ActiveWorkbook. Name, ".xls", "")
ActiveSheet.Select
Activesheet.Name = Left$(Activeworkbook.Name, InStrRev(Activeworkbook.Name,".")-22)
Range("A1").Select
End Sub
Macro 2 to merge workbooks:
Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub
