Multi Source Data Copy Macro

Question

Hi all,

I wrote this macro with the help of the internet. Assume you have lots of source files in a directory that you want to copy all data from (ex headers) and paste the data into a single master spreadsheet.

I want the user to be able to browse to their source folder using a folder select dialogue and then the rest of the macro should run as per the code. However, it seems to break because of the myfile definition i.e. it is a folder name and then wildcard for all the available excel files. ( Workbooks.Open foldername & myFile)

any help would be greatly appreciated as to how to fix this. I am by no means an expert.

Thanks

Sub MultiFileSource()

'Sets the name for the two "in use" files

Dim foldername As String

 With Application.FileDialog(msoFileDialogFolderPicker)

   .AllowMultiSelect = False

   .Show

   On Error Resume Next

   foldername = .SelectedItems(1)

   Err.Clear

   On Error GoTo 0

 End With

 Dim myFile As String, myCurrFile As String, counter As Integer

    myCurrFile = ThisWorkbook.Name

    'myFile = Dir("C:\Users\Rob\Desktop\Excel\SourceData\*.xls")  'set the path to where all the source files are copied to

    myFile = Dir(foldername & "\*.xlsx")

'loops a lookup of each file in the source directory copying all data except the 1st row (to avoide dupe headers)

'then copies that data to the master file at the next available blank row

Do Until myFile = ""

 Workbooks.Open foldername & myFile    'set the path to where all the source files are copied to

 Workbooks(myFile).Activate

 ActiveCell.Offset(1, 0).Select

 Range(Selection, Selection.SpecialCells(xlLastCell)).Select

  Selection.Copy

 Workbooks(myCurrFile).Activate

    Range("A1").Select

    ActiveCell.End(xlDown).Offset(1, 0).Select

    ActiveSheet.Paste

  Workbooks(myFile).Close savechanges:=False

 counter = counter + 1

 myFile = Dir

Loop

MsgBox ("Finished and processed " & counter & " files") 'This displayes a message box inc. the value of Counter

End Sub

Answer 1

Using the following code will do what you want:

Sub DataPull()

Dim foldername As String

Dim Source As Workbook

Dim Target As Workbook

Dim counter As Long

Dim strFile As String

Dim fd As FileDialog

Dim i As Long, m As Long, n As Long

Set Target = ActiveWorkbook

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd

    .Title = "Select the folder that contains the files that you want to import."

    If .Show = -1 Then

        strFolder = .SelectedItems(1) & ""

    Else

        MsgBox "You did not select a folder."

        Exit Sub

    End If

End With

strFile = Dir$(strFolder & "*.xlsx")

counter = 0

While strFile <> ""

    Set Source = Workbooks.Open(strFolder & strFile)

    With Target.Sheets(1).Range("A1")

        i = .CurrentRegion.Rows.Count

        For m = 1 To Source.Sheets(1).Range("A1").CurrentRegion.Rows.Count - 1

            For n = 0 To Source.Sheets(1).Range("A1").CurrentRegion.Columns.Count - 1

                .Offset(i, n) = Source.Sheets(1).Range("A1").Offset(m, n)

            Next n

            i = i + 1

        Next m

    End With

    counter = counter + 1

    Source.Close xlDoNotSaveChanges

    strFile = Dir$()

Wend

MsgBox ("Finished and processed " & counter & " files") 'This displayes a message box inc. the value of Counter

End Sub