Copying values from various Workbooks and Worksheets into other Workbook

Question

I'm trying to loop through worksheets from various workbooks and copy values (starting with a single cell). I need to paste the copied values into a worksheet in a new workbook one below another in the first row.

I work with three workbooks. Each workbooks has two sheets.

I loop through all worksheets in the three workbooks.

Following problem occurs: only the values from the second sheets are copied into the master file.

Sub RunOnAllFilesInFolder()

    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
    Dim ID As String
    Dim counter As Integer
    Dim i As Integer

    counter = 2
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path

    If fDialog.Show = -1 Then
        folderName = fDialog.SelectedItems(1)
    End If

    Set eApp = New Excel.Application: eApp.Visible = False
    Set eApp2 = New Excel.Application: eApp.Visible = False
    Set wb2 = eApp2.Workbooks.Add

    fileName = Dir(folderName & "\*.xls")

    Do While fileName <> ""

        Application.StatusBar = "Processing " & folderName & "\" & fileName
        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)

        For Each ws In wb.Worksheets
            ws.Range("A1").Copy
        Next ws

        wb2.Worksheets(1).Cells(counter, 1).PasteSpecial xlPasteValues

        wb.Close SaveChanges:=False
        Debug.Print "Processed" & folderName & "\" & fileName
        fileName = Dir()
        counter = counter + 1

    Loop

    wb2.SaveAs ("Results.xlsx")
    eApp.Quit
    Set eApp = Nothing
    eApp2.Quit
    Set eApp2 = Nothing

    Application.StatusBar = ""
    MsgBox "Completed executing Macro"

End Sub

Answer 1

Looks like the issue is with your worksheet Looping. You are copying the content from a worksheet but pasting the value after the worksheet loop. That's why you are getting values from only one sheet. The below code should work for you.

Sub RunOnAllFilesInFolder()

        Dim folderName As String, eApp As Excel.Application, fileName As String
        Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
        Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
        Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
        Dim ID As String
        Dim counter As Integer
        Dim i As Integer

        counter = 2
        fDialog.Title = "Select a folder"
        fDialog.InitialFileName = currWb.Path

        If fDialog.Show = -1 Then
            folderName = fDialog.SelectedItems(1)
        End If

        Set eApp = New Excel.Application: eApp.Visible = False
        Set eApp2 = New Excel.Application: eApp.Visible = False
        Set wb2 = eApp2.Workbooks.Add

        fileName = Dir(folderName & "\*.xls")

        Do While fileName <> ""

            Application.StatusBar = "Processing " & folderName & "\" & fileName
            Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)

            For Each ws In wb.Worksheets
                ws.Range("A1").Copy
                wb2.Worksheets(1).Cells(counter, 1).PasteSpecial xlPasteValues
                counter = counter + 1
            Next ws

            wb.Close SaveChanges:=False
            Debug.Print "Processed" & folderName & "\" & fileName
            fileName = Dir()
        Loop

        wb2.SaveAs ("Results.xlsx")
        eApp.Quit
        Set eApp = Nothing
        eApp2.Quit
        Set eApp2 = Nothing
        Application.StatusBar = ""
        MsgBox "Completed executing Macro"
    End Sub