Excel VBA pulled data from source in directory and merge into newly created workbook

Question

I'm very much a beginner with VBA and am having trouble taking the below and doing the following.

1. Create a new workbook called Results1
2. In all the files in that directory that don't begin with "Results", get cell B11 and every 18th row in B after that until last row.
3. Merge all of (2) into Results1.xls column B

---

Path = "C:\Users\John\Desktop\"

Filename = Dir(Path & "*.xls")

Do While Filename <> ""

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

Loop

Answer 1

This is 100% not tested so I would anticipate some errors from my quickly dumping it out and fat fingering... but it should definitely get you in the ballpark.

Make use of F9 in the code to set break points. Also toggle on your Immediate and Locals window in the View>> drop down in your VBE. These will help troubleshoot as your script is running.

Sub mergeSheets()
    '1. Open a new workbook to receive the data also create a variable to tell which row we are writing to

    'Declare the variables we will be using here
    'This helps us troubleshoot since VBA will know what "Type" the variable is.
    Dim wbWrite As Workbook
    Dim rngWrite As Range

    Set wbWrite = Workbooks.Add
    Set rngWrite = wbWrite.Sheets("Sheet1").Range("B1")

    '2. Open a directory and loop through the excel sheets

    'Gonna need some more variables here
    Dim path As String
    Dim FileName As String
    Dim wbRead As Workbook
    Dim wsRead As Worksheet
    Dim intLastRow As Integer
    Dim intReadRow As Integer

    'Set the path and all that jazz
    path = "C:\Users\John\Desktop\"
    FileName = Dir(path & "*.xls")

    'Loop!
    Do While FileName <> ""

        'In all the files in that directory that don't begin with "Results"
        If Left(FileName, 7) <> "Results" Then
            'Open the workbook found and stick it in a variable so we can reference it
            Set wbRead = Workbooks.Open(FileName, , True)

            'Loop through the worksheets in the workbook
            ' by looping each worksheet in the workbook's Sheets collection
            For Each wsRead In wbRead.Sheets
                ', get cell B11 and every 18th row in B after that until last row.

                'Last row
                intLastRow = wsRead.Range(wsRead.Rows.Count).End(xlUp).Offset(-1).Row

                'Start at row 11 and step every 18 rows until you hit the last row
                For intReadRow = 11 To intLastRow Step 18

                    '3. Merge all of (2) into Results1.xls column B
                    rngWrite.value = wsRead.cells(intReadRow, 2).value

                    'go to the next row to write to
                    Set rngWrite = rngWrite.Offset(1)
                Next intReadRow
            Next wsRead

            'Close the workbook we are reading
            wbRead.Close
            Set wbRead = Nothing
        End If

        'Get the next file for the next iteration of this loop
        fileName = Dir
    Loop

    'We are done. Lets save this workbook
    wbWrite.SaveAs (path & "/Results.xls")

End Sub