Searching for a macro to get started - opening and importing multiple workbooks into one

Here is the situation.  I have a groups of 3 files that I want to import (user to select, different folder every time) into one workout and rename each sheet accordingly.  Each file name will have have identifying prefix but otherwise end as:
#####AllBursts_clean
#####AllData_clean
#####RRI_clean

I want all of these consolidated into one workbook, naming each sheet for each of the above workbooks like:
AllBursts_Sheet1
Allbursts_Sheet2
AllData_Sheet1
AllData_Sheet2
and so on...

I have been looking for macros but most of what I find are for text files...these are excel files.  

Can anyone point me in the right direction?
Brad MatushewskiResearch AssociateAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Herer's an example from Ron de Bruin. You'll probably want to change line 24.
Sub Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Application.DefaultFilePath

    ' You can also use a fixed path.
    'MyPath = "C:\Users\Ron de Bruin\Test"

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
            Title:="Select a file or files", _
            MultiSelect:=True)

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(Fname(N))
                On Error GoTo 0

                If Not mybook Is Nothing Then
                    MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
                           "And after you press OK, it will be closed" & vbNewLine & _
                           "without saving. You can replace this line with your own code."
                    mybook.Close SaveChanges:=False
                End If
            Else
                MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
            End If
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Brad MatushewskiResearch AssociateAuthor Commented:
That is a great start...It allows me to select multiple files.  This macro open and then closes them.  I found the spot in the VBA where I would have it do some action (such as import each sheet), but as a NOOB, I am afraid that is currently beyond my ability to make happen.
0
Martin LissOlder than dirtCommented:
I added lines 8 and 45 to 47.
Sub Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook
    Dim ws As Worksheet

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Application.DefaultFilePath

    ' You can also use a fixed path.
    'MyPath = "C:\Users\Ron de Bruin\Test"

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
            Title:="Select a file or files", _
            MultiSelect:=True)

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(Fname(N))
                For Each ws In mybook.Worksheets
                    ' Do something with each ws (=worksheet)
                Next
                On Error GoTo 0

                If Not mybook Is Nothing Then
                    MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
                           "And after you press OK, it will be closed" & vbNewLine & _
                           "without saving. You can replace this line with your own code."
                    mybook.Close SaveChanges:=False
                End If
            Else
                MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
            End If
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
This version copies the sheets to the main workbook. I added lines 9 and 11 and changed line 49.
Sub Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook
    Dim ws As Worksheet
    Dim wbMain As Workbook
    
    Set wbMain = ActiveWorkbook
    
    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Application.DefaultFilePath

    ' You can also use a fixed path.
    'MyPath = "C:\Users\Ron de Bruin\Test"

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
            Title:="Select a file or files", _
            MultiSelect:=True)

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(Fname(N))
                For Each ws In mybook.Worksheets
                    ws.Copy After:=wbMain.Sheets(wbMain.Sheets.Count)
                Next
                On Error GoTo 0

                If Not mybook Is Nothing Then
                    MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
                           "And after you press OK, it will be closed" & vbNewLine & _
                           "without saving. You can replace this line with your own code."
                    mybook.Close SaveChanges:=False
                End If
            Else
                MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
            End If
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
I'm sorry but I just realized that I never posted this function that's called from Select_File_Or_Files_Windows.

Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.