Consolidate same format sheet from different files into one file

[curiousglasses]

Hello everyone,

I want to create a master file to consolidate 1 sheet from 10 different files.
For example, the name of the sheet I want : FREE, the names of the different files : Europe / America / Africa.
So I copy the sheet Free from Europe / America / Africa and paste them into one master file.

I need a vba code for the master file where it will copy paste the FREE sheet from every file and paste it into the corresponding sheet ("Free" sheet from Europe, to be pasted in the Master file sheet "Europe")
I tried quite a lot, I managed to make a code to combine the sheets but then I have to manually change the name of the sheets to recognize them and it make its harder for any more automated work I need to do on the file.

I have looked at almost all the posts made about this subject, but I can't seem to adapt the codes to my need.

This is what I have so far :

Sub COMBINEextract()
Dim fd As FileDialog
Dim FilePicked As Integer, f As Integer
Dim sWb As Workbook
Dim ws As Worksheet

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "C:\Test" 'Adjust initial folder as needed
fd.AllowMultiSelect = True
FilePicked = fd.Show

Application.ScreenUpdating = False

If FilePicked = 0 Then
    Application.ScreenUpdating = True
    Exit Sub
Else
    For f = 1 To fd.SelectedItems.Count
        Set sWb = Workbooks.Open(fd.SelectedItems(f))
        For Each ws In sWb.Worksheets
            If ws.Name = "PT&C Free" Then
                ws.Copy _
                After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            End If
        Next ws
        sWb.Close False
    Next f
End If

Application.ScreenUpdating = True

End Sub

I hope I made myself clear, Thank you !

 

[mumps]

Is the sheet name "FREE" or "PT&C Free"? What are the full names of the Europe / America / Africa files including the extension?

 

[curiousglasses]

Is the sheet name "FREE" or "PT&C Free"? What are the full names of the Europe / America / Africa files including the extension?

Hello

The name is of the sheet is PT&C Free
the full names of the files :

Europe.xls
NAO.xlsx
SAO.xlsx
India.xlsx
ASEAN.xlsx
China.xlsx
SAF.xlsx
Russia.xlsx

Thank you !

 

[mumps]

Place this macro in the Master file and run it from there:

Sub COMBINEextract()
    Dim fd As FileDialog, FilePicked As Integer, f As Long, sWb As Workbook, desWb As Workbook, shName As String
    Set desWb = ThisWorkbook
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    FilePicked = fd.Show
    Application.ScreenUpdating = False
    If FilePicked = 0 Then
        Application.ScreenUpdating = True
        Exit Sub
    Else
        For f = 1 To fd.SelectedItems.Count
            Set sWb = Workbooks.Open(fd.SelectedItems(f))
            shName = Split(sWb.Name, ".")(0)
            If Not IsError(Evaluate("=ISREF('[" & desWb.Name & "]" & shName & "'!$A$1)")) Then
                Sheets("PT&C Free").UsedRange.Copy desWb.Sheets(shName).Range("A1")
            Else
                MsgBox ("The sheet named " & shName & " does not exist in the Master file.")
            End If
            sWb.Close False
        Next f
    End If
    Application.ScreenUpdating = True
End Sub

 

[curiousglasses]

Place this macro in the Master file and run it from there:

Sub COMBINEextract()
    Dim fd As FileDialog, FilePicked As Integer, f As Long, sWb As Workbook, desWb As Workbook, shName As String
    Set desWb = ThisWorkbook
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    FilePicked = fd.Show
    Application.ScreenUpdating = False
    If FilePicked = 0 Then
        Application.ScreenUpdating = True
        Exit Sub
    Else
        For f = 1 To fd.SelectedItems.Count
            Set sWb = Workbooks.Open(fd.SelectedItems(f))
            shName = Split(sWb.Name, ".")(0)
            If Not IsError(Evaluate("=ISREF('[" & desWb.Name & "]" & shName & "'!$A$1)")) Then
                Sheets("PT&C Free").UsedRange.Copy desWb.Sheets(shName).Range("A1")
            Else
                MsgBox ("The sheet named " & shName & " does not exist in the Master file.")
            End If
            sWb.Close False
        Next f
    End If
    Application.ScreenUpdating = True
End Sub

Thank you ! it worked perfectly !

 

[mumps]

You are very welcome.