0

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
Community
  • 1
  • 1
  • 1
    Starting by [avoiding Select and Activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) might be a good step. – BigBen Feb 01 '22 at 21:41
  • Sure let me give it a try! – Nandakishore Feb 01 '22 at 21:43
  • 1
    Does the value for `directory` have a terminating \ ? Does your code actually open any files? Some basic debugging steps would be useful to follow here: eg. https://www.myonlinetraininghub.com/debugging-vba-code – Tim Williams Feb 01 '22 at 21:58
  • The directory does not have any terminating. The issue seems to be pulling data from the files i.e. opening the files – Nandakishore Feb 01 '22 at 22:11
  • You need to add the \ at the end of the path or `Dir()` will not find your files – Tim Williams Feb 01 '22 at 22:47

1 Answers1

0

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125