VBA Copy Worksheets Loop through Files in the Same Folder (Paste Source Formatting)

[MochaLatte]

Hello! I really need your help!

Ideally, the code should open specific directory (folder).
Loop while opening all the Excel workbooks inside the folder.
Copy “sheet1” from each workbook and paste it onto my active work. The worksheet should be copied using PasteSpecial (Paste:=xlPasteAllUsingSourceTheme)
because of some special format/color that I would like to preserve from the original workbook.

I got this code online, I would like to give credit to the person who created it. The code is doing exactly what I need, but it is not pasting UsingSourceTheme.

Any help will be greatly appreciated!!!!!!!!!


Sub CombineFiles()

'Change the folder path as necessary
Const strFldrPath As String = "C:\Department\Projects\Current Projects\Project folder Beta\"

On Error GoTo InvalidPath: ChDir strFldrPath
Dim arrWBs As Variant
Dim wbDest As Workbook
Dim wbData As Workbook
Dim wbIndex As Long
Dim ws As Worksheet

arrWBs = Application.GetOpenFilename("Excel Files, *.xls*", , , , True)
If Not IsArray(arrWBs) Then Exit Sub
Set wbDest = ActiveWorkbook

Application.ScreenUpdating = False
For wbIndex = 1 To UBound(arrWBs)
Set wbData = Workbooks.Open(arrWBs(wbIndex))

'## This is the Select Case statement
Select Case wbData.Name
Case "Department Detail.xls": Set ws = wbData.Sheets("Sheet1")
Case "Unit Detail.xls": Set ws = wbData.Sheets("Sheet1")
Case "Cost Center Detail.xls": Set ws = wbData.Sheets("Sheet1")
Case "Region Detail.xls": Set ws = wbData.Sheets("Sheet1")
Case "Summary by Territory.xls": Set ws = wbData.Sheets("Sheet1")
Case Else: MsgBox "Invalid workbook selection """ & wbData.Name & """"
End Select

If Not ws Is Nothing Then ws.Copy After:=wbDest.Sheets(wbDest.Sheets.Count)



wbData.Close False
Next wbIndex
Application.ScreenUpdating = True
Exit Sub

InvalidPath:
MsgBox "Unable to find folder """ & strFldrPath & """"
Exit Sub

End Sub