Try this codes, see how it fits you:
Sub Collect_Data() Dim DstWks2 As Worksheet Dim LastRow As Long Dim R As Long Dim SrcWkb As Workbook Dim StartRow As Long Dim wkbname As Variant Dim xlsFiles As Variant 'Starting column and row for the destination workbook C = 1 R = 1 'Set references to destination workbook worksheet objects Set DstWks1 = ThisWorkbook.Worksheets("Formdata") Set DstWks2 = ThisWorkbook.Worksheets("Formdata2") 'Starting row on source worksheet StartRow = 11 'Get the workbooks to open xlsFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True) Application.AskToUpdateLinks = False If VarType(xlsFiles) = vbBoolean Then Exit Sub 'Loop through each workbook and copy the data to this workbook For Each wkbname In xlsFiles Set SrcWkb = Workbooks.Open(Filename:=wkbname, ReadOnly:=True) LastRow = SrcWkb.Worksheets("Data").Cells(Rows.Count, "BG").End(xlUp).Row If LastRow >= StartRow Then With SrcWkb.Worksheets("Data") DstWks1.Cells(R, C).Resize(LastRow - StartRow + 1, 1).Value = _ .Range(.Cells(StartRow, "BG"), .Cells(LastRow, "BG")).Value End With End If LastRow = SrcWkb.Worksheets("Data").Cells(Rows.Count, "CB").End(xlUp).Row If LastRow >= StartRow Then With SrcWkb.Worksheets("Data") DstWks2.Cells(R, C).Resize(LastRow - StartRow + 1, 1).Value = _ .Range(.Cells(StartRow, "CB"), .Cells(LastRow, "CB")).Value End With End If C = C + 1 SrcWkb.Close savechanges:=False Next wkbname End Sub



or: