Importing multiple worksheets
First, no need to do :
Sht.Activate and then
ActiveSheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)

This is heavily slowing the process (avoid Activate and Select as much as possible).



Then you can turn off more (see comments) in the Application to speed up your code :

Dim CalcMode As Long
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    'Turn off events (like Workbook_Open, Worksheet_Change, ...)
    .EnableEvents = False
    'Turn off the Status Bar
    .DisplayStatusBar = False
    'Store initial calculation mode
    CalcMode = .Calculation
    'And set it to manual
    .Calculation = xlCalculationManual
End With 'Application


I've amended a bit your error handler to go back to the part where we reset all those parameters for a regular use.



Opening your workbooks as read-only (as you don't modify them), should improve the speed a bit.



Finally, the use of With/End With allow the code to know which object you are using for multiple rows and will provide a better/faster access to it.



So all of this will speed up your code, but copying sheets is a bit ressources-demanding so it'll probably still be a long, especially if you are opening big files!

Sub SKR_Import()
On Error GoTo ErrorHandler

    Dim CalcMode As Long
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .DisplayStatusBar = False
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
    End With 'Application

    Dim wB1 As Workbook
    Dim wB2 As Workbook
    Dim Sht As Worksheet
    Dim fD As FileDialog
    Dim FileChosen As Integer
    Dim FileName As String
    Dim i As Long

    Set fD = Application.FileDialog(msoFileDialogOpen)
    With fD
        .AllowMultiSelect = True
        .Title = "Select Excel workbooks to import all sheets"
        FileChosen = .Show
    End With

    Set wB1 = ActiveWorkbook
    With wB1
        If FileChosen = -1 Then
            For i = 1 To fD.SelectedItems.Count
                'Open as read-only
                Set wB2 = Workbooks.Open(fD.SelectedItems(i), , True)
                For Each Sht In wB2.Sheets
                    Sht.Copy after:=.Sheets(.Sheets.Count)
                Next Sht
                wB2.Close SaveChanges:=False
            Next i
        End If
    End With 'wB1

ProperExit:
On Error GoTo 0
    wB1.Activate
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .DisplayStatusBar = True
        .Calculation = CalcMode
    End With 'Application
Exit Sub
ErrorHandler:
    MsgBox Err.Number &amp; vbCrLf &amp; Err.Description, vbCritical + vbOKOnly, "Error"
    wB2.Close SaveChanges:=False
    Resume ProperExit
End Sub