CODEWITHSUNDEEP
excelvba
art_d
art_d

Reputation: 1

Merge excel workbooks, name sheets after file names

I have a code to merge multiple excel files into one workbook. I'm struggling to add some code to name newly created sheets after file names they were taken from.

Please help.

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 "Procesed " & 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

Upvotes: 0

Views: 2798

Answers (1)

Harassed Dad
Harassed Dad

Reputation: 4704

Your problem is that you are copying many sheets from each file - so you can't just name the sheets after the source file name. And if you append the filename to the existing sheet name you may hit the 31 character limit on sheet names. Assuming that isn't a problem you would do:

After 

 wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

Add

 wbkCurBook.Sheets(wbkCurBook.Sheets.Count).name = left(wksCurSheet.name & wbkSrcBook.name,31)

But I suspect this will fail to produce sufficiently different names unless your files are very distinct

Upvotes: 1

Related Questions