Option Explicit

Sub CopyDataFromWorkbooks6()
    Dim wb As Workbook
    Dim masterWb As Workbook
    Dim sourceWb As Workbook
    Dim sourceSheet As Worksheet
    Dim masterSheet As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim lastRow As Long
    'Dim FullName As String

    ' Set the folder path
    folderPath = ThisWorkbook.Path & "\" ' Ensure the path ends with a backslash
    fileName = Dir(folderPath & "*.xls*")
    
    ' Create or set the Master Workbook
    Set masterWb = ThisWorkbook
    Set masterSheet = masterWb.Sheets("Sheet1")
    
    ' Clear existing data in Master Sheet
    'masterSheet.Cells.Clear
    
    ' Disable alerts
    Application.DisplayAlerts = False
    
    ' Loop through each workbook in the folder
    Do While fileName <> ""
    
        Set sourceWb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        On Error Resume Next
        Set sourceSheet = sourceWb.Sheets("Out")
        On Error GoTo 0
        
        If Not sourceSheet Is Nothing Then
         
            ' Find the last row in Master Sheet
            lastRow = masterSheet.Cells(masterSheet.Rows.Count, 1).End(xlUp).Row
            
            ' Copy UsedRange from source sheet and paste to Master Sheet
            sourceSheet.UsedRange.Copy
            masterSheet.Cells(lastRow + 2, 1).PasteSpecial Paste:=xlPasteAll
            
            ' Close the source workbook
            sourceWb.Close False
         masterWb.Save
         
        End If
        
        
        fileName = Dir

        
    Loop
    
'ThisWorkbook.Close

    Application.DisplayAlerts = True

ThisWorkbook.Save
Application.Workbooks.Open (ThisWorkbook.FullName)
    
End Sub