Copy Data from multiple workbooks into Master workbooks

zeromax1

New Member
Joined
Mar 20, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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.

Code:
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
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

zeromax1

New Member
Joined
Mar 20, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
However, I try to re edit the code and make it can select multiple files. it fail.

VBA Code:
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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,712
Not looked in detail, but this line:
VBA Code:
AllowMultiSelect = ture
should be:
VBA Code:
.AllowMultiSelect = True

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

Watch MrExcel Video

Forum statistics

Threads
1,127,336
Messages
5,624,093
Members
416,011
Latest member
chengkoonwing

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top