Try this
Option Explicit
Sub Combine()
Dim sFileTyp As String
Dim sFileName As String, sFolder As String
Dim oDonor As Presentation
Dim oTarget As Presentation
Dim i As Integer
On Error GoTo errhandler
Set oTarget = ActivePresentation
sFileTyp = "*.PPTX"
sFolder = browseFolder(, "Where are the PowerPoints?")
If Len(sFolder) = 0 Then Exit Sub
sFileName = Dir(sFolder & "\" & sFileTyp)
Do While Len(sFileName) > 0
Set oDonor = Presentations.Open(sFolder & "\" & sFileName, msoFalse)
For i = 1 To oDonor.Slides.Count
oDonor.Slides(i).Copy
With oTarget.Slides.Paste(oTarget.Slides.Count + 1)
.Design = oDonor.Slides(i).Design
.ColorScheme = oDonor.Slides(i).ColorScheme
End With
Next I
oDonor.Close
Set oDonor = Nothing
sFileName = Dir()
Loop
MsgBox "DONE!"
NormalExit:
Exit Sub
ErrorHandler:
Call MsgBox("Error:" & vbCrLf & Err.Number & vbCrLf & Err.Description, _
vbOKOnly, "Error inserting files")
Resume NormalExit
Exit Sub
errhandler:
MsgBox "Sorry, there was an error"
End Sub
'returns file name as string, vbnullstring if canceled
Function browseFolder(Optional sInitFolder As String = vbNullString, _
Optional Title As String = "Select Folder or Cancel to Exit") As String
Dim fd As FileDialog
If Len(sInitFolder) = 0 Then sInitFolder = CreateObject("Shell.Application").Namespace(CVar(5)).Self.Path
If Right(sInitFolder, 1) <> "\" Then sInitFolder = sInitFolder & "\"
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.InitialFileName = sInitFolder
.Title = Title
If .Show = -1 Then
browseFolder = .SelectedItems(1)
Else
browseFolder = vbNullString
End If
End With
Set fd = Nothing
End Function