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

[kpev]

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

 

[JLGWhiz]

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]

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]

OK, try this.

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]

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]

Thannks for the feedback,
regards, JLG