Alex, this sounds very similar to what I needed to do recently.

The code below will
- open all the excel files in a specified folder,
- extract the specified data to a new row in a new workbook.

The original source code is from: https://msdn.microsoft.com/en-us/lib...ice.14%29.aspx

The code has been modified to allow the end-user to specify the file folder location in cell B5 of the macro-containing Summary Generator file. Thanks to users Spitfireblue and Bakerman2 for their input in this post: http://www.excelforum.com/showthread...8928&p=4384578

Let me know if this is what you were trying to do.

Jonny

Sub MergeAllWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    
    ' Source of main macro:  https://msdn.microsoft.com/en-us/library/office/gg549168(v=office.14).aspx
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    ' Set the location of the files you want to pull data from.
    ' In my case, File location is entered in cell B5 as a link, ie, \\server\folder\subfolder\
    FolderPath = ThisWorkbook.Sheets("Sheet1").Range("B5").Value
    
    ' Insert header row into row 3 of the summary workbook
    SummarySheet.Cells.Range("A3").Value = "File Name"
    SummarySheet.Cells.Range("B3").Value = "First Name"
    SummarySheet.Cells.Range("C3").Value = "Last Name"
    SummarySheet.Cells.Range("D3").Value = "Address 1"
    SummarySheet.Cells.Range("E3").Value = "Address 2"
    SummarySheet.Cells.Range("F3").Value = "City"
    SummarySheet.Cells.Range("G3").Value = "Province"
    SummarySheet.Cells.Range("H3").Value = "Payment"
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
    ' I use row 4 so i can insert header rows above (row 3) and title, etc.
    NRow = 4
    
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "*.xl*")
    
    ' Loop until Dir returns an empty string.
    Do While FileName <> ""
        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & FileName)
        
        ' Set the cell in column A to be the source file name.
        SummarySheet.Range("A" & NRow).Value = FileName
        
        ' Set the source range
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        ' in my case, the sheet name is "Summary Payment"
        Set SourceRange = WorkBk.Worksheets("Summary Payment").Range("A4:B4")
        
        ' Set the destination range to start at column B and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        ' Set second source range.
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets("Summary Payment").Range("B27:F27")
        
        ' Set the destination range to start at column D and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("D" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
        
        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
        
        ' Use Dir to get the next file name.
        FileName = Dir()
    Loop
    
    ' Call AutoFit on the destination sheet so that all
    ' data is readable.
    SummarySheet.Columns.AutoFit
End Sub