Loop instruction through list of known paths

Question

I have a list of files with the same structure and I want to extract some information from columns A, B, and C and print it to another workbook. I found a way to do it for a single file, but now I don't understand how can I do it using the list of given files. I tried using collections, but it doesn't work.

Here's what I came up with:

Sub Pulsante1_Click()
    Dim FileGeStar As Variant
    Dim myCol As Collection
    Set myCol = New Collection

    myCol.Add "C:\Users\xxx\Desktop\articoli_def.xlsx"
    myCol.Add "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx"

    For Each FileGeStar In myCol
        Workbooks.Open Filename:=FileGeStar
        FileGeStar = Application.ActiveWorkbook.Name

        Dim Code As String
        Dim Description As String
        Dim FilePath As String

        Dim i As Long
        i = 2
        While Range("A" & i) <> ""
            FilePath = Application.ActiveWorkbook.Path
            Code = Trim(Range("A" & i).Value)
            Description = Trim(Range("B" & i).Value)

            Workbooks("Report.xlsm").Worksheets(1).Range("A" & i).Value = FilePath
            Workbooks("Report.xlsm").Worksheets(1).Range("B" & i).Value = Code
            Workbooks("Report.xlsm").Worksheets(1).Range("C" & i).Value = Description
            i = i + 1
        Wend
    Next FileGeStar
End Sub

What can I do?

Answer 1

To loop though files, you can indeed use a collection, or an array, you can also loop through all files in directory with certain extension, or partial file name. Check out DIR function.

Best not to use ActiveWorkbook, better approach would be to set a workbook object like so: Set wb = Workbooks.Open(fullPathToYourWorkbook).

For what you're doing, there's no need to go row by row, much more efficient way would be to copy entire range, not only it's a lot quicker but also it's only 1 line of code; assuming your destination is ThisWorkbook.Sheets(1) and wb object is set: wb.Range("A:C").Copy Destination:=Thisworkbook.Sheets(1).Range("A:C"). If you need to edit copied data (trim or whatever) consider Range Replace method.

However, if you want to go row by row for whatever reason, as BigBen mentioned in the comment - get rid of While loop.

It's a good idea to set Application.ScreenUpdating to False when opening/closing workbooks, then back to True once it's all done. It will prevent user from accidentaly clicking something etc and will make it look like it's not opening any workbook.

Here's my approach (untested) assuming the workbook you want to copy data to is Workbooks("Report.xlsm").Worksheets(1):

Sub Pulsante1_Click()

'set workbook object for the destination workbook 
set wb_dest = Workbooks("Report.xlsm").Worksheets(1)

'disable screen updating
Application.ScreenUpdating = False

For Each target_wb In Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")

    'set wb object and open workbook
    Set wb = Workbooks.Open(target_wb)

    'find last row in this workbooks in columns A:B (whichever is greater)
    LastRow = wb.Range("A:B").Find(What:="*", After:=wb.Range("A1"), SearchDirection:=xlPrevious).row

    'copy required data
    wb.Range("A1:B" & LastRow).Copy Destination:=wb_dest.Range("B1:C" & LastRow)

    'fill column A with path to the file
    wb_dest.Range("A1:A" & LastRow).Value = wb.Path

    'close workbook
    wb.Close False

Next

'enable screen updating
Application.ScreenUpdating = True

End Sub

Obviously an array is not the best approach if you have loads of different files, collection would be a lot clearer to read and edit in the future, unless you want to create a dynamic array, but there's no need for that in my opinion. I didn't declare variables or write any error handling, it's a simple code just to point you in the right direction.

If you want to disable workbook events or/and alerts, you can set Application.DisplayAlerts and Application.EnableEvents to False temporarily.

Answer 2

This might look like an overkill, but I hope the code and comment's are self explanatory:

Option Explicit
Sub Pulsante1_Click()

    Dim DestinationWorkbook As Workbook
    Set DestinationWorkbook = ThisWorkbook 'I think report.xlsm is the workbook running the code
    'if report.xlsm is not the workbook running the code then change thisworkbook for workbooks("Report.xlsm")

    'add as many paths as you need to, another way would be to write them in a sheet and loop through to fill the array
    Dim MyPaths As Variant
    MyPaths = Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")

    'Declare a workbook variable for the source workbooks
    Dim SourceWorkbook As Workbook

    'Declare a long variable to loop through your path's array
    Dim i As Long

    'loop through the start to the end of your array (will increase as the array does)
    For i = LBound(MyPaths) To UBound(MyPaths)
        Set SourceWorkbook = OpenWorkbook(MyPaths(i)) 'this will set the workbook variable and open it
        CopyData SourceWorkbook, DestinationWorkbook 'this will copy the data to your destination workbook
        SourceWorkbook.Close , False
        Set SourceWorkbook = Nothing
    Next i

End Sub
Private Function OpenWorkbook(FullPath As String) As Workbook
    Set OpenWorkbook = Workbooks.Open(FullPath, False, True)
End Function
Private Sub CopyData(wbO As Workbook, wbD As Workbook)

    'this procedure calculates the last row of your source workbook and loops through all it's data
    'later calls the AddDataToMasterWorkbook procedure to paste the data
    With wbO.Sheets(1) 'Im assuming your source workbook has the data on sheet1
        Dim LastRow As Long
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row

        Dim FilePath As String
        FilePath = wbO.Path

        Dim Code As String
        Dim Description As String

        Dim C As Range
        For Each C In .Range("A2:A" & LastRow) 'this will loop from A2 to the last row with data
            Code = Trim(C)
            Description = Trim(C.Offset(, 1))
            AddDataToMasterWorkbook wbD, FilePath, Code, Description
        Next C
    End With

End Sub
Private Sub AddDataToMasterWorkbook(wb As Workbook, FilePath As String, Code As String, Description As String)
    'This procedure calculates the last row without data and adds the items you need every time
    With wb.Sheets(1)
        Dim LastRow As Long
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & LastRow) = FilePath
        .Range("B" & LastRow) = Code
        .Range("C" & LastRow) = Description
    End With

End Sub