Macro isn't consolidating data

[tinkerv102]

Hello,

I am trying to code macro to consolidate all workbooks in a file on my computer. My macro seems to work but is not pasting in data from the other files into my master (zbook1). Can anyone assist?

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:\Users\n0234704\Desktop\LOGS"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "zbook1.xlsx" Then
Exit Sub
End If

Workbooks.Open (Filepath & MyFile)
Range("A10:O10").Copy
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 15))

MyFile = Dir
Loop
End Sub

 

[Yongle]

Try this instead
- copies and pastes before the file is closed
- only needs the first cell of pasteTo range

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow As Long
    [COLOR=#ff0000]Dim rng As Range[/COLOR]
    Dim Filepath As String
    Filepath = "C:\Users\n0234704\Desktop\LOGS"
    MyFile = Dir(Filepath)
    
    Do While Len(MyFile) > 0
        If MyFile = "zbook1.xlsx" Then Exit Sub
     
        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        [COLOR=#ff0000]Set rng = Worksheets("Sheet1").Cells(erow, 1)[/COLOR]
        
        Workbooks.Open (Filepath & MyFile)
        Range("A10:O10").Copy[COLOR=#ff0000] rng[/COLOR]
        
        ActiveWorkbook.Close
        MyFile = Dir
    Loop
End Sub

This ensures correct workbook is active when range is set
Better generaly to qualify reference with workbook

 

[Yongle]

When dealing with multiple workbooks it is safer to qualify ranges so that the correct workbook is written to
The same code would look like this

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow As Long
    Dim Filepath As String
[COLOR=#ff0000]    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Sheet1")[/COLOR]
    Filepath = "C:\Users\n0234704\Desktop\LOGS"
    MyFile = Dir(Filepath)
    
    Do While Len(MyFile) > 0
        If MyFile = "zbook1.xlsx" Then Exit Sub
     
        erow = [COLOR=#ff0000]ws.[/COLOR]Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
       
        Workbooks.Open (Filepath & MyFile)
        [COLOR=#ff0000]Range("A10:O10").Copy ws.Cells(erow, 1)[/COLOR]
        
        ActiveWorkbook.Close
        MyFile = Dir
    Loop
End Sub

 

[tinkerv102]

Hello Yongle,

Thank you for your post. I attempted the fix referenced above and the macro now does not function. It doesn't even begin to attempt to import the data from the other files. Would you have any insight? I am fairly new to macros and this one has for sure been stumping me for some time now.

 

[Yongle]

Away from PC until later so cannot test anything.
Which version of the code are you running?
Please confirm that you are wanting to paste to next row in sheet named Sheet1 (you used Sheet1 as both sheet name (is what's on the tab) and as a VBA CodeName in your first post (both may be correct)
Sheet1.Range = CODENAME
Worksheets ("Sheet1") = SHEETNAME
I am away from forum now for about 8 hours and will update thread after that

 

[Yongle]

I did just spot this in your code

If MyFile = "zbook1.xlsx" Then
Exit Sub

You do not want to exit sub, you simply want to skip the file and try the next one, like this

If MyFile <>"zbook1.xlsx" Then
 do what I want including closing the file
End If
MyFile = Dir
Loop

Will post full amended code later

 

[tinkerv102]

The sheet name I want to consolidate to is Sheet1 but the workbooks that I am attempting to consolidate have different names for their sheets. Must they all state sheet1?

 

[Yongle]

Is it the first sheet in every workbook?
If it is then Sheet1.Range is correct

 

[tinkerv102]

It is.

 

[Yongle]

Workbook zbook1.xlsx is presumed open when the macro is run
Line added to activate zbook1.xlsx ensures it becomes the active workbook (which is then set to variable wbS)
If MyFile <> wbS.Name Then makes VBA ignore the source file
Variable wb is used for each opened workbook
wb.sheets(1) identifies the first sheet in the workbook (this notation is the sheet INDEX number, which is its current location in the workbook)
After pasting wb is saved and closed (your original VBA was not saving before closing)

Sub LoopThroughDirectory()
    Application.ScreenUpdating = False                          'reduce screen flickering
    Dim MyFile As String
    Dim erow As Long
    Dim Filepath As String
    Dim ws As Worksheet, wb As Workbook, wbS As Workbook
    
    Filepath = "C:\Users\n0234704\Desktop\LOGS\"               
    Workbooks("zbook1.xlsx").Activate
    Set wbS = ActiveWorkbook
    Set ws = wbS.Sheets("Sheet1")                               'sheet with tab name "Sheet1"
    
    MyFile = Dir(Filepath)
    
    Do While Len(MyFile) > 0
        If MyFile <> wbS.Name Then
            Set wb = Workbooks.Open(Filepath & MyFile)
            With wb.Sheets(1)                                   'first sheet in opened file
                erow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                ws.Range("A10:O10").Copy .Cells(erow, 1)
            End With
            wb.Save
            wb.Close False
        End If
        MyFile = Dir
    Loop
End Sub