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

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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...


:)
 
Upvote 0
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
 
Upvote 0
other idea which came up after posting

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

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

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
Back
Top