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!!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
You state that your files have extension .xls yet you are using xl365 version. Would you confirm the file extension for the source files?
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

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
Back
Top