Import Multi Workbooks to seperate tabs

[fiftimedun]

New to VBA and this is over my head, any assistance would be greatly appreciated:

I have multiple workbooks that i need imported into a single workbook but each workbook must go on to its own tab. I would like the operation to give you the option to search for the folder that contains all of the workbooks (they will be in the same folder, but the folder will change)

Notes:
-Workbooks have a date at the end so the end must be wildcard
-Workbooks must be able to be assigned to copy their data to a tab that has a different name than the origin workbook, eg. workbook "Red", imports to tab "Seven"
--i can manually name and assign the workbook/tab names or provide a sample of what i am working with (there are 21 reports to import, each to seperate tabs)

Here is what i have to search for the folder, but i don't really understand how it works or what to do with it...

Sub test()
    
    MsgBox "Please navigate to the folder containing the files to process."
    
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
        On Error Resume Next
        fileLocation = .SelectedItems(1)
    End With
   
    If fileLocation = "" Then
        End
    End If
    
End Sub

Thank you all in advance for your time!

 

[hiker95]

fiftimedun,

See if something below will assist you (there are 4 sections to the code):

Jerry Beaucaire's - Excel Assistant
WBs to Sheets
https://sites.google.com/a/madrocke...-excelassistant/merge-functions/wbs-to-sheets

 

[fiftimedun]

I really need the ability to have the user select the folder that the reports are in so i can have that directory saved as a variable.
i don't understand how the msoFileDialogFolderPicker gives me/allows me to store the variable.

eg. You use msoFileDialogFolderPicker to pick a directory (say C:/The Folder) and then i can have directory stored as the variable TheDir

 

[hiker95]

fiftimedun,

To keep your post at the top of all new posts, do the following several times per day.

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[hiker95]

Duplicate response.

 

[fiftimedun]

on that link it does have something i might be able to use, it's a little over complicated, but it might work... the only thing is i get an error on the section:

'

Option Explicit
Sub ConsolidateWBsToSheets2()
'Author:     Jerry Beaucaire'
'Date:       6/23/2010     (2007 compatible)
'Summary:    Open all Excel files in a specific folder and copy
'            one sheet from the source files into this master workbook
'            naming sheets for the names of the source workbooks
'            Move imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long, shtAdd As String, ShtName As Worksheet
Dim wbData As Workbook, wbkNew As Workbook
'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
  
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
  
'Path and filename (edit this section to suit)
    fPath = "C:\Users\Desktop\Desktop\ADLS - Copy\WorkingCopy\ADLS\Reports\"                  'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xls")                'listing of desired files, edit filter as desired
'Import data from each found file
    Do While Len(fName) > 0
    'make sure THIS file isn't accidentally reopened
        If fName <> wbkNew.Name Then
        
[COLOR=#008000]'This is the section to customize, what to copy and to where
        'Get name of workbook without extension[/COLOR]
            shtAdd = Left(fName, InStr(fName, ".") - 1)
       [COLOR=#008000] 'Open file[/COLOR]
            Set wbData = Workbooks.Open(fPath & fName)
            
      [COLOR=#008000]  'Rename sheet and copy to target workbook[/COLOR]
            [COLOR=#ff0000][B]wbData.Sheets(1).Name = shtAdd     'error here: says: you typed an invalid name
                                                                          ' for a sheet or chart...[/B][/COLOR]
            wbData.Sheets(1).Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
        
[COLOR=#008000]'close source file[/COLOR]
            wbData.Close False
        'move file to IMPORTED folder
            Name fPath & fName As fPathDone & fName
        'ready next filename, reassert the list since a file was moved
            fName = Dir(fPath & "*.xls")
        End If
    Loop
ErrorExit:    'Cleanup
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

The code notes say to customize it but it looks like variables that should handle itself...? help?

 

[fiftimedun]

bump

 

[fiftimedun]

bump

 

[John_w]

I have multiple workbooks that i need imported into a single workbook but each workbook must go on to its own tab. I would like the operation to give you the option to search for the folder that contains all of the workbooks (they will be in the same folder, but the folder will change)

Notes:
-Workbooks have a date at the end so the end must be wildcard
-Workbooks must be able to be assigned to copy their data to a tab that has a different name than the origin workbook, eg. workbook "Red", imports to tab "Seven"

The following code satisfies all except the last requirement, for which you need to be more specific: exactly what is the system for naming the imported sheet after the name of the workbook from which it is imported? Is there a pattern? Or Is it done via a one-to-one lookup? As it stands, each imported sheet is given the name of the original sheet name with the sheet index number appended.

Sub Import_1st_Sheet_From_All_Workbooks_In_Folder()

    Dim folder As String, fileName As String
    Dim thisWb As Workbook
    Dim i As Integer
    
    Set thisWb = ActiveWorkbook
    
    folder = ""
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then folder = .SelectedItems(1)
    End With
    
    If folder <> "" Then
        i = 0
        fileName = Dir(folder & "\*.xls")
        While fileName <> ""
            i = i + 1
            Workbooks.Open folder & "\" & fileName
            With ActiveWorkbook
                .Sheets(1).Copy After:=thisWb.Sheets(thisWb.Sheets.Count)
                .Close savechanges:=False
                thisWb.Sheets(thisWb.Sheets.Count).Name = thisWb.Sheets(thisWb.Sheets.Count).Name & " " & thisWb.Sheets.Count
            End With
            fileName = Dir
        Wend
    End If
    
End Sub

 

[fiftimedun]

See this is where i hate to say it, but i'll have to do an individual adding of a bunch of "if....like..then..end if" statements because here is an example of the naming system on the sheet:

Filename: 354_LRS-Air_Force_2A_Culture_General_Course_(ZZ133104)-Users-12-28-2012.xls
Tab: Culture Gen Report