Copy Data from multiple workbooks into Master workbooks

[zeromax1]

Hello all, I am new to VBA and I am going to study about how to copy some data from different workbooks into a master workbooks.

All source data are copy from row 6 column B in source excel and the tab name "source".
The destination file tab call "Master", they all have a same format.

I found two vba code from mumps and I want to combine them together. It means I can click the button to select the excel files and then copy the data into the master file.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\Hello\Documents\"
    ChDir strPath
    strExtension = Dir("*.xlsx*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Source").Range("C6:AP" & Range("C" & Rows.Count).End(xlUp).Row).Copy wkbDest.Sheets("MASTER").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
            
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Code 2, I want to copy multiple workbooks by select one time.

Sub CopySheet()
Application.ScreenUpdating = False
Dim flder As FileDialog
Dim FileName As String
Dim FileChosen As Integer
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Set wkbDest = ThisWorkbook

OpenFile:
Set flder = Application.FileDialog(msoFileDialogFilePicker)
flder.Title = "Please Select an Excel File"
flder.InitialFileName = "c:\"
flder.InitialView = msoFileDialogViewSmallIcons
flder.Filters.Clear
flder.Filters.Add "Excel Files", "*.xls*"
MsgBox ("Select a folder and then a file to open.")
FileChosen = flder.Show
FileName = flder.SelectedItems(1)
 
Set wkbSource = Workbooks.Open(FileName)
wkbSource.Sheets("Sheet1").UsedRange.Copy
wkbDest.Sheets("Master").Cells(wkbDest.Sheets("Master").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

Application.CutCopyMode = False
Application.ScreenUpdating = True
wkbSource.Close savechanges:=False
If MsgBox("Do you want to open another workbook?", vbYesNo) = vbYes Then GoTo OpenFile
End Sub

 

[zeromax1]

However, I try to re edit the code and make it can select multiple files. it fail.

Sub CopySheet()
Application.ScreenUpdating = False
Dim flder As FileDialog
Dim FileName As String
Dim FileChosen As Integer
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Set wkbDest = ThisWorkbook


OpenFile:
Set flder = Application.FileDialog(msoFileDialogFilePicker)
flder.Title = "Please Select an Excel File"
flder.InitialFileName = "c:\"
flder.InitialView = msoFileDialogViewSmallIcons
flder.Filters.Clear
flder.Filters.Add "Excel Files", "*.xlsx*"
AllowMultiSelect = ture
MsgBox ("Select a folder and then a file to open.")
FileChosen = flder.Show
FileName = flder.SelectedItems(3)

'strExtension = Dir("*.xlsx*")

'Do While strExtension <> ""

Set wkbSource = Workbooks.Open(FileName)


With wkbSource.Sheets("2020 WK21 MASTER").Range("C6:AP" & Range("C" & Rows.Count).End(xlUp).Row).Copy
wkbDest.Sheets("2020 WK20 MASTER").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

Application.CutCopyMode = False
Application.ScreenUpdating = True
wkbSource.Close savechanges:=False

End With
'strExtension = Dir
        
'Loop

End Sub

 

[John_w]

Not looked in detail, but this line:

AllowMultiSelect = ture

should be:

.AllowMultiSelect = True

Also put Option Explicit at the top of the module, compile it and fix any other errors.