VBA Help

SamBo1234

Board Regular
Joined
Aug 21, 2006
Messages
77
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

Code:
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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, try this
Code:
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

Board Regular
Joined
Aug 21, 2006
Messages
77
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
in your question, there was
i.e the Footer
so the code has
Code:
            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
Code:
            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

Board Regular
Joined
Aug 21, 2006
Messages
77

ADVERTISEMENT

Thanks Eric,

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

Code:
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

Board Regular
Joined
Aug 21, 2006
Messages
77
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832

ADVERTISEMENT

you're WELCOME !!

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

SamBo1234

Board Regular
Joined
Aug 21, 2006
Messages
77
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Code:
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
Code:
            '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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
other idea which came up after posting

this is more secure
Code:
.Sheets(i).Name = extract_filename(file_fullname) & " " & .Sheets(i).Name
 

Forum statistics

Threads
1,136,990
Messages
5,678,989
Members
419,797
Latest member
ikethegenius

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top