Would like a Macro to Combine data from the same worksheet in multiple files into one

I have 10 different files in 1 folder. Each file has multiple worksheets and each worksheet is named. All the files have a worksheet named "Out". All the columns in this worksheet named "Out" are the same with different data in each column. I would like to see the VBA code for a macro that would take the data from the same worksheet in all the files and combine the data into one file.

Thanks,

Mike

Sintek:

The macro functions as desired but at the end there is a warning message that the main workbook is already open and do you want to reopen it ?

How to make that go away ?

I simply ran the macro. No other testing.

Have to step away for a few hours.

I'm thinking there is a setting in Excel that I am overlooking. But I don't know what or where.

Here is another macro that does the same thing of copy/paste and then reopens the workbook as read only. I can't figure that out either.
There are a number of code lines that are commented out during my testing for different solutions.

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

Sintek :

After much more research I located the issue with my macro.

Change this line of code : Set sourceWb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)

To this : Set sourceWb = Workbooks.Open(folderPath & fileName, ReadOnly:=False)

Problem solved.



With your macro I was able to solve my issue with these changes :

Option Explicit

Sub J3v16()
Dim Data, File As Object, Path As String, i As Long
Path = "C:\Users\logit\OneDrive\Desktop\New Folder"

Application.DisplayAlerts = False
With CreateObject("Scripting.FileSystemObject").GetFolder(Path)
    For Each File In .Files
        
        With Workbooks.Open((File), ReadOnly:=False)
            '! Assumes data starts in A1 ...
            Data = Sheets("Out").Cells(1).CurrentRegion
            .Close False
            
        End With
        ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
        
    Next File
   ActiveWorkbook.Save
   ActiveWorkbook.Close
   Application.Quit
End With

End Sub

Thank you for your time.