VBA: copy rows of data from multiple WBs to Master

[bubblystace]

Hi All,

The below macro is currently grabbing a single column of data from selected WBs and pasting it into a master sheet. I want it changed so it grabs all rows from row 3 onwards. How would I modify it to do this and include .xls files? thanks!

Sub Main()
Dim wbMe As Workbook
Dim wbBatch As Workbook
Dim wsMe As Worksheet
Dim wsBatch As Worksheet
Dim arstrFiles() As String


Application.ScreenUpdating = False


i = 0
Set wbMe = ThisWorkbook
Set wsMe = wbMe.Sheets("Master")


'Select the batch of Files
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Spreadsheets", "*.xlsx", 1
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            i = i + 1
            ReDim Preserve arstrFiles(i)
            arstrFiles(i - 1) = vrtSelectedItem
        Next vrtSelectedItem
    End If
End With


'get last row in this sheet
intFirstMTRow = ThisWorkbook.Sheets("Master").Range("A1048500").End(xlUp).Row + 1


For j = 1 To UBound(arstrFiles) Step 1
    'open file in batch and extract data
    Set wbBatch = Workbooks.Open(arstrFiles(j - 1))
    Set wsBatch = wbBatch.Sheets("Defects")
    intColumn = 1
    'Modify to copy all rows from 3 onwards
[COLOR=#ff0000]    For k = 4 To 300[/COLOR]
[COLOR=#ff0000]        If wsBatch.Range("a" & k).Value <> "" Then[/COLOR]
[COLOR=#ff0000]            wsMe.Cells(intFirstMTRow, intColumn) = wsBatch.Range("A" & k).Value[/COLOR]
[COLOR=#ff0000]            intColumn = intColumn + 1[/COLOR]
[COLOR=#ff0000]        End If[/COLOR]
[COLOR=#ff0000]    Next k[/COLOR]
[COLOR=#ff0000]    intFirstMTRow = intFirstMTRow + 1[/COLOR]
[COLOR=#ff0000]    wbBatch.Close savechanges:=False[/COLOR]

Next j




Application.ScreenUpdating = True


End Sub