Bringing data from mulitple worksheets to a master sheet

You won't need to copy the header row, but what about the "consistent data"?

You'll have to test this. The code first asks the user to select a Folder containing the files. Then copies the data from each workbook to the one containing the code.

I just get a "no workbooks found" error.


Other xls sheets will also be present in the folder that do not relate to this.

I would prefer to hard code each file location into the script and have little or no user intervension - the spread sheet is opened - It gets all the data from the other spreadsheets - It sorts that data it shows the data.

I understand this will need chaging when new salesman begin or someone leaves but I would prefer it that way

Originally Posted by kgkev

I just get a "no workbooks found" error.


Other xls sheets will also be present in the folder that do not relate to this.

I would prefer to hard code each file location into the script and have little or no user intervension - the spread sheet is opened - It gets all the data from the other spreadsheets - It sorts that data it shows the data.

I understand this will need chaging when new salesman begin or someone leaves but I would prefer it that way

If the folder you select contains excel files they will be opened and if they contain data it will be copied.

To hard code the path you only need this macro

Sub Get_Data_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 this path  
            .LookIn = "C:/MyFolder" 
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
            .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(2, 1)
                        bHeaders = True
                    End If
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With


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