Combine multiple sheets from multiple books into one

[jasocke2]

Hi all,

What I am trying to do it quite simple (I hope!)

I have 6 spreadsheets all within the same folder, these are pretty much identical (rows, colums, sheets within them) apart from the names of the files.

I then have a master spreadsheet within the same folder where I want to combine all the data, from all the sheets within each book (if that makes sense!) apart from the data on the last sheet within each book as this is the reference data, onto one sheet within this master file. If possible I only want to copy rows accross which have complete data too.

So: (names not correct)
From book1.xls copy all data on sheets (sheet1, sheet2 etc) except last sheet
From book2.xls copy all data on sheets (sheet1, sheet2 etc) except last sheet
combine onto masterfile.xls on sheet1.

I have searched on here and can only find how to do it with the first sheet in each workbook, not looping through all the sheets in each book. Please see below.

Many thanks in advance.

Sub Get_Value_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
            GoTo search
        End If
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
                                 uRng.Columns.Count).Clear
search:
        With .FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "z:\Test"
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    If bHeaders Then
                        'headers exist so don't copy
                        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                    rToCopy.Columns.Count).Copy rNextCl
                        'no headers so copy
                        'place headers in Row 2
                    Else: rToCopy.Copy Cells(1, 1)
                        bHeaders = True
                    End If
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With

    Columns("A:E").Select
    Columns("A:E").EntireColumn.AutoFit

        On Error GoTo 0
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub