VBA Help

[SamBo1234]

Hi All i have this code, which allows me to import multiple Workbooks into the same one with a click of a button.

The problem i have got is that i need to include somewhere in the code, a way to add the name of the file, once inported to the TAB, i.e the Footer. Im not an expert in VBA, does anyone have any tips to do this ?

Many Thanks
Sam

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        Sheets().Move After:=ThisWorkbook.Sheets _
          (ThisWorkbook.Sheets.Count)
                 
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[erik.van.geit]

Hi, try this

Option Explicit


Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
    Dim ShCnt As Integer
    Dim i As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        
        With ThisWorkbook
        ShCnt = .Sheets.Count
        Sheets().Move After:=.Sheets(ShCnt)
            For i = ShCnt + 1 To .Sheets.Count
            .Sheets(i).PageSetup.CenterFooter = FilesToOpen(x)
            Next i
        End With
        
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

kind regards,
Erik

 

[SamBo1234]

Hi Eric,

Thanks for your reply and help, i have just tried this and its still not adding the File Name to the Tabs at the bottom once its been imported.

FYI

The Workbooks I am merging all have a different file name but the same tab name within the workbook. So to differentiate the Workbooks from one and other once they have been imported i need to replace the existing Tab name with the File name of the imported Workbook.

Many Thanks, I really appreciate your help.

 

[erik.van.geit]

in your question, there was

i.e the Footer

so the code has

            For i = ShCnt + 1 To .Sheets.Count 
            .Sheets(i).PageSetup.CenterFooter = FilesToOpen(x) 
            Next i

check the Footers of your sheets: you will find the entire path of the original workbook
this path (or filename only) could be put anywhere in a cell, if you want

            For i = ShCnt + 1 To .Sheets.Count 
            .Sheets(i).Range("A1") = FilesToOpen(x) 
            Next i

NOTE: you cannot rename multiple worksheets (TAB) to the same name

if you want to rename the tabs then you'll need another system to avoid errors

best regards,
Erik

 

[SamBo1234]

Thanks Eric,

Sorry for the inaccurate details, i didnt explain myself correctly.

For i = ShCnt + 1 To .Sheets.Count 
            .Sheets(i).Range("A1") = FilesToOpen(x) 
            Next i

This will do almost the same thing as i want so thanks for your help and support.

Best Regards
Sam

 

[SamBo1234]

Just one quick question,

Is it possible to return just the File name, rather than the entire string. If i could do this that would be excellent.

Regards

 

[erik.van.geit]

you're WELCOME !!

"almost" ?: feel free to ask more if needed

 

[SamBo1234]

Hi Eric,

Sorry if im confuesing you!.

I have files which are named like the following,

File1.xls
File2.xls
File3.xls

Etc

I would like the names of the files to reflect on the (TABS) when all sheets have been imported into the workboot.

So rather than have sheet1, sheet2, sheet3, sheet4 along the bottom i would have File1.xls, File2.xls, File3.xls, File4.xls etc etc

Rather than haveing the Path listed in the Header/Footer etc of the sheet.

But if this cannot be done then having the File name on each sheet would work either way...

 

[erik.van.geit]

Option Explicit

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
    Dim ShCnt As Integer
    Dim i As Integer
    Dim file_fullname As String
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        
        With ThisWorkbook
        ShCnt = .Sheets.Count
        Sheets().Move After:=.Sheets(ShCnt)
            For i = ShCnt + 1 To .Sheets.Count
            file_fullname = FilesToOpen(x)
            .Sheets(i).PageSetup.CenterFooter = extract_filename(file_fullname)
            Next i
        End With
        
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Function extract_filename(FN As String) As String
'returns filename if fullpath is entered
'Erik Van Geit
'060921
Dim i As Integer

i = InStrRev(FN, Application.PathSeparator)

    ''elder excelversions
    'For i = Len(FN) To 1 Step -1
    'If Mid(FN, i, 1) = Application.PathSeparator Then Exit For
    'Next i
    
extract_filename = Mid(FN, i + 1, Len(FN) - i)

'without extension: enable next part
i = InStrRev(extract_filename, ".")

    ''elder excelversions
    'For i = Len(extract_filename) To 1 Step -1
    'If Mid(extract_filename, i, 1) = "." Then Exit For
    'Next i

extract_filename = Left(extract_filename, i - 1)
End Function

at your own risk replace the Footer-codeline by

            'you asked this, which is DANGEROUS
            .Sheets(i).Name = extract_filename(file_fullname)

this will only work if there is only one sheet per workbook

 

[erik.van.geit]

other idea which came up after posting

this is more secure

.Sheets(i).Name = extract_filename(file_fullname) & " " & .Sheets(i).Name