How to pull data from multiple workbooks in a folder? - excel

Question

I have hundreds of Excel (Microsoft® Excel® for Microsoft 365 MSO (16.0.14326.20702) 32-bit ) files in a folder which have one sheet in common.
For example- Let's consider the sheet as "data".
I want to pull specific cells (C2:C15) out of each of them and transpose them into a separate "masterfile".
This code runs unsuccessfully.
Sub ExtractData()
Dim masterfile As Workbook
Dim wb As Workbook
Dim directory As String
Dim fileName As String
Dim NextRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set masterfile = ThisWorkbook
directory = masterfile.Worksheets("Sheet1").Range("E1")
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(directory & fileName)
wb.Worksheets("data").Range("C2:C15").Copy
masterfile.Activate
NextRow = Cells(Rows.Count, "C").End(xlUp).Row + 1
Worksheets("Sheet1").Range("C" & NextRow).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
wb.Close savechanges:=False
End If
fileName = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Data has been Compiled, Please Check!"
End Sub

Answer 1

Some suggestions:
Sub ExtractData()
Dim masterSheet As Worksheet
Dim wb As Workbook
Dim directory As String
Dim fileName As String, cDest As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set masterSheet = ThisWorkbook.Worksheets("Sheet1")
directory = masterSheet.Range("E1").Value
'### ensure trailing path separator ###
If Right(directory, 1) <> "\" Then directory = directory & "\"
'first paste location
Set cDest = masterSheet.Cells(masterSheet.Rows.Count, "C").End(xlUp).Offset(1)
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(directory & fileName)
wb.Worksheets("data").Range("C2:C15").Copy
cDest.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Set cDest = cDest.Offset(1) 'next paste row
wb.Close savechanges:=False
End If
fileName = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Data has been Compiled, Please Check!"
End Sub