Macro built to pull data from multiple workbooks in a folder not working although it runs successful-CodePudding

I have hundreds of excel(Microsoft® Excel® for Microsoft 365 MSO (16.0.14326.20702) 32-bit ) files in a folder which has one sheet in common. For example- Lets 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". Below is the code i am trying to use but unable to figure out where i am going wrong:

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

Any help would be much appreciated!! Thank you

CodePudding user response：

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