VBA Excel - open and copy from several workbook to one summary sheet (paste on sequential raw)

Question

I need to open and copy the information from several workbooks and from the same cells of the same sheet name, to one summary sheet. I am using the following VBA code that is working but it paste everything in the same raw (resulting in having the information in only one raw from last workbook opened). I need the Macro to paste each time it start a loop on the following raw. How can I do this?

Here's the code I have so far:

Sub AllWorkbooks()
    Dim MyFolder As String 'Path collected from the folder picker dialog
    Dim MyFile As String 'Filename obtained by DIR function
    Dim wbk As Workbook 'Used to loop through each workbook
    On Error Resume Next

    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If

        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder

    End With

    MyFile = Dir(MyFolder) 'DIR gets the first file of the folder

    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> “”
       'Opens the file and assigns to the wbk variable for future use
       Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
       'Replace the line below with the statements you would want your macro to perform


    Range("B3").Select
    Selection.Copy
    Windows("Forecast.xlsm").Activate
    Cells(3, 1).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        wbk.Activate
    Range("C11:J11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Forecast.xlsm").Activate
    Cells(3, 4).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        wbk.Close savechanges:=False

       MyFile = Dir 'DIR gets the next file in the folder
    Loop

    Application.ScreenUpdating = True

    End Sub

Answer 1

From what I understand, you just want to copy values from some ranges in different files to subsequent rows in another file.

To copy a range of cells in VBA you don't have to select them. It is better to use Range.Copy method.

In your case you probably want to do something like:

wbk.Worksheets(1).Range("C11:J11").Copy _
    destination:=ThisWorkbook.Worksheets(1).Range("D4")

By the way: Cells(3, 1).Offset(1, 0) is the same as: Cells(4,1) .

To paste each time to the next row you can just count them. Outside of the while loop declare a variable. For example: Dim i as Integer . Then in each iteration increment it: i = i + 1 . Then you can copy like this:

wbk.Worksheets(1).Range("C11:J11").Copy _
    destination:=ThisWorkbook.Worksheets(1).Range( Chr(Asc("D")+i) & ":4")

Answer 2

Sub Forecast() Dim MyFolder As String 'Path collected from the folder picker dialog Dim MyFile As String 'Filename obtained by DIR function Dim wbk As Workbook 'Used to loop through each workbook Dim i As Integer On Error Resume Next

Application.ScreenUpdating = False

'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
        MsgBox "You did not select a folder"
        Exit Sub
    End If

    MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder

End With

MyFile = Dir(MyFolder) 'DIR gets the first file of the folder

'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> “”
   'Opens the file and assigns to the wbk variable for future use
   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
   'Replace the line below with the statements you would want your macro to perform

wbk.Worksheets("Dashboard ctc").Range("B3").Copy
Workbooks("Forecast.xlsm").Worksheets(1).Range("A" & Chr(Asc("3") + i)).PasteSpecial Paste:=xlPasteValues

wbk.Worksheets("Dashboard ctc").Range("B11:J11").Copy
Workbooks("Forecast.xlsm").Worksheets(1).Range("D" & Chr(Asc("3") + i)).PasteSpecial Paste:=xlPasteValues

i = i + 1


wbk.Close savechanges:=False

   MyFile = Dir 'DIR gets the next file in the folder
Loop

Application.ScreenUpdating = True

End Sub