VBA code to loop through user-defined directory and copy data from a range of cells in each workbook to a master workbook

kpev

New Member
Joined
Apr 24, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi!

I am new to VBA and I have a folder with approximately 130 xls files, all with unique workbook names and worksheet names.

I would like to create VBA code that allows the user to select the directory folder of the files to copy data from the range C2:J2 from the first worksheet in each of the files and paste the values to the first sheet of a master workbook ("Compiled.xlsm", saved in the same directory as the source files) range A2:H2 and down until data from each file in the directory has been populated into the master "Compiled" workbook.

I have tried a number of different codes without success. I would really appreciate any help. Thank you!!
 

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You state that your files have extension .xls yet you are using xl365 version. Would you confirm the file extension for the source files?
 

kpev

New Member
Joined
Apr 24, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
You state that your files have extension .xls yet you are using xl365 version. Would you confirm the file extension for the source files?
Thanks for your reply. They are indeed .xls files.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
OK, try this.

VBA Code:
Sub t()
Dim fName As String, wb As Workbook, sh As Worksheet
Set sh = Workbooks("Compiled.xlsm").Sheets(1)
CYC:
fName = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
Set wb = Workbooks.Open(fName)
wb.Sheets(1).Range("C2:J2").Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
wb.Close False
ans = MsgBox("Is there another file to copy?", vbYesNo + vbQuestion, "CONTINUE?")
    If ans = vbYes Then GoTo CYC:
End Sub
 

kpev

New Member
Joined
Apr 24, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Thanks! I figured out a different approach using the following code:

Sub PastevaluestoMaster()

Dim CopyRangeSt As String
CopyRangeSt = "C2:J2"

Dim PasteRangeSt As String
PasteRangeSt = "A2:H2"

Dim MasterWorkBook As Workbook
Set MasterWorkBook = ThisWorkbook

Dim MasterSheet As Worksheet
Set MasterSheet = MasterWorkBook.Sheets(1)


Dim SelectedPath As String
Dim counter As Long
counter = 0

Dim FileDiag As FileDialog
Dim fileCount As Long

Set FileDiag = Application.FileDialog(msoFileDialogFilePicker)
With FileDiag
.AllowMultiSelect = True
.Show
End With

If FileDiag.SelectedItems.Count > 0 Then

For fileCount = 1 To FileDiag.SelectedItems.Count

Dim dataBook As Workbook
Set dataBook = Workbooks.Open(FileDiag.SelectedItems(fileCount))

Dim dataSheet As Worksheet
Set dataSheet = dataBook.Sheets(1)

MasterSheet.Range(PasteRangeSt).Offset(counter) = dataSheet.Range(CopyRangeSt).Value
counter = counter + 1

Next fileCount

End If

End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Thannks for the feedback,
regards, JLG
 

Watch MrExcel Video

Forum statistics

Threads
1,127,198
Messages
5,623,312
Members
415,966
Latest member
ctorohuamanchumo

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