Browse for excel data files to import

Hello,

I have an Excel application.
My user has many input files (all of them in the same format).
I want to write a moudle which will :

- open a file browser in which the user will select all the data files by once.
- go over the selected files : open each file and copy data to one excel file.

Can you help me or tell me where can I find an example to this task ?
Thank you

Here's some code that I use, you can test it & adapt it yourself. It will only copy data, not the header rows

'Loop through all workbooks in Directory
'Copy data, only copy Headers once
Option Explicit

' API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
                                                                                       pszpath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
                                   As Long

Public Type BrowseInfo
    hOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Function GetDirectory(Optional msg) As String
    On Error Resume Next
    Dim bInfo As BrowseInfo
    Dim sPath As String
    Dim r As Long, x As Long, pos As Integer

    'Root folder = Desktop
    bInfo.pIDLRoot = 0&

    'Title in the dialog
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Please select the folder containing the Excel files to copy."
    Else
        bInfo.lpszTitle = msg
    End If

    'Type of directory to return
    bInfo.ulFlags = &H1

    'Display the dialog
    x = SHBrowseForFolder(bInfo)

    'Parse the result
    sPath = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal sPath)
    If r Then
        pos = InStr(sPath, Chr$(0))
        GetDirectory = Left(sPath, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
Sub Get_Data_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
            GoTo search
        End If
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
                                 uRng.Columns.Count).Clear

search:
        With .FileSearch
            .NewSearch
            'Get directory containing files
            .LookIn = GetDirectory
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
                    If bHeaders Then
                        'headers exist so don't copy
                        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                    rToCopy.Columns.Count).Copy rNextCl
                        'no headers so copy
                        'place headers in Row 2
                    Else: rToCopy.Copy Cells(2, 1)
                        bHeaders = True
                    End If
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With


        On Error GoTo 0
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save