Automatically transfer data from multiple workbooks into a master workbook

[Porkchopping]

I am trying to automatically transfer data from nonadjacent cells (C1, B5,B10,B16,B22,B28) from multiple workbooks in a masterworkbook folder from A2:F2. I am a novice at VBA. I am not able to copy as Range("C1,B5,B10,B16,B22,B28") and the way it currently is coded only the last copied range (B28) is pasted to the master workbook. The data pastes to A2 in the master workbook instead of F2 where I want it. I need help copying the cells from the workbooks into row 2 in the master bookbook. Thanks in advance. Here is what I currently have:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\ToolFolder\WorkObjectives\")
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (MyFile)
Range("C1").Copy
Range("B5").Copy
Range("B10").Copy
Range("B16").Copy
Range("B22").Copy
Range("B28").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, 6))
MyFile = Dir
Loop
End Sub

 

[JLGWhiz]

Hi JLGWhiz,

Thanks for replying.

You are right that I want to list subsequent iterations of the copied data in the next row.

I received a Run-time error 1004: That command cannot be used on multiple sections. It appeared at:
rng.Copy Workbooks("zmaster.xlsm").Sheets(1).Cells(Rows.Count, 2).End(xlUp)(2)

I had something similar occur when I placed all the ranges together in one line of coding.

OK, we will just have to do it the hard way then.

Sub LoopThroughDirectory()
Dim MyFile As String, rng As Range, wb As Workbook, i As Long, j As Long
MyFile = Dir("C:\ToolFolder\WorkObjectives\*.xl*")
    Do While Len(MyFile) > 0
        If MyFile = "zmaster.xlsm" Then
            Exit Sub
        End If
        Set wb = Workbooks.Open(MyFile)
            With wb.Sheets(1)
                rngArr = Array("C1", "B5", "B10", "B16", "B22", "B28")
                For i = LBound(rngArr) To UBound(rngArr)
                    j = j + 1
                    .Range(rngArr(i)).Copy Workbooks("zmaster.xlsm").Sheets(1).Cells(Rows.Count, j).End(xlUp)(2)
                Next
            End With
        wb.Close
        MyFile = Dir
    Loop
End Sub

 

[JLGWhiz]

Need to add to Dim statements: rngArr As Variant
Knew I left something out. It will probably run without it, but a tidy house never hurts.

 

[dmt32]

Hi Dave,
Much appreciated.
Ryan

Hi Ryan,
without seeing any changes you may have made, I created some test files for code & all seemed to work ok.
I have made couple minor adjustments see if any improvement for you.

Option Base 1
Sub LoopThroughDirectory()
    Dim MyFile As String, sPath As String
    Dim data(6) As Variant
    Dim wsMaster As Worksheet
    Dim wbSource As Workbook
    Dim erow As Long
    Dim i As Integer
    Dim Item As Range
    
    'Your Master Sheet
    'CHANGE SHEET INDEX /NAME AS REQUIRED
    Set wsMaster = ThisWorkbook.Worksheets(1)
    
    sPath = "C:\ToolFolder\WorkObjectives\"
    
    MyFile = Dir(sPath)
    Application.ScreenUpdating = False
    Do While Len(MyFile) > 0
        If MyFile <> "zmaster.xlsm" Then
        Set wbSource = Workbooks.Open(MyFile)
        'Source Copy Sheet
        'CHANGE SHEET INDEX /NAME AS REQUIRED
        With wbSource.Sheets(1)
            i = 1
            For Each Item In .Range("C1,B5,B10,B16,B22,B28")
                data(i) = Item.Value
                i = i + 1
            Next
        End With

        erow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        wsMaster.Range("A" & erow & ":F" & erow).Value = data
        MyFile = Dir
        wbSource.Close False
        Set wbSource = Nothing
        Erase data
    End If
    Loop
    Application.ScreenUpdating = True
End Sub

Hope Helpful

Dave

 

[Porkchopping]

OK, we will just have to do it the hard way then.
QUOTE]
It's nearly perfect. All the correct data from all the files copied and pasted over to the master workbook. The only thing is that it copied straight across row 2 and doesn't drop to row 3, row 4, etc. for each copied file. So instead of going to A3 it continues to G2.
Thanks again,
Ryan

 

[Porkchopping]

Hi Dave,
None of the changes I have been playing with proved beneficial so there is nothing much for me to share with you.

Again thank you for helping me. The recent coding opened the files but stopped responding before anything pasted to the master workbook. Not Responding appeared at the top of the Excel page.

Ryan

 

[dmt32]

Code as posted worked ok for me - Clearly something has changed but sorry if my solution does not help you.

Dave

 

[Porkchopping]

Interestingly when I re-opened the master workbook it contained all the data in the columns but was missing one file.
Ryan

 

[dmt32]

Interestingly when I re-opened the master workbook it contained all the data in the columns but was missing one file.
Ryan

so it does work then?

you have a filter in the loop "If MyFile <> "zmaster.xlsm" which excludes the file - is this the one which is missing?

Dave

 

[Porkchopping]

I think that for the most part it is working, there is just something that is not completing and it must be close to the end. When I re-opened it there was one set of data missing but everything else looks perfect.
Although the 'zmaster' file does not copy either, it is actually a file in the middle of the folder that is not copying and pasting. I removed it from the folder to see if that file was the issue, but I still receive the Not Responding message and had to force close.
Ryan

 

[Porkchopping]

[/QUOTE]

Code as posted worked ok for me - Clearly something has changed but sorry if my solution does not help you.

Dave

Thank you for taking the time to help me though. I really appreciate it.

Ryan