Quicker import macro

[Lizard07]

The import macro I currently have copies all the sheets from one workbook into another, but it takes hours! If there is a way to make it quicker I would definitely appreciate your help. The current code is below.

Sub ImportDriverTripReport()
Dim ImportItemCount, RowCount As Integer
Dim DCSwb, ImportWb As Workbook
Dim ImportDate As Integer
Dim FileLocation As String
Dim x As Integer

Application.StatusBar = "Please Select the file to Import..."
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
'Import the driver trip report sheet
FileLocation = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
'::: IMPORT THE DATA INTO THE TEMPLATE :::
Set DCSwb = ActiveWorkbook
Application.StatusBar = "Importing File..."
'Opens the file the user specified
Workbooks.Open Filename:=FileLocation
Set ImportWb = ActiveWorkbook

For x = 1 To ActiveWorkbook.Sheets.Count
'Loop through each of the sheets in the workbook by using x as the sheet index number.
ActiveWorkbook.Sheets(x).Activate
ActiveWorkbook.Sheets(x).Copy _
After:=DCSwb.Sheets("Control Panel")
Workbooks.Open Filename:=FileLocation
Set ImportWb = ActiveWorkbook
'Puts all copies after the last existing sheet.

Application.StatusBar = Null

Next

ActiveWorkbook.Close True
End Sub

 

[John_w]

Try this:

Sub ImportDriverTripReport()
    Dim ImportItemCount, RowCount As Integer
    Dim DCSwb, ImportWb As Workbook
    Dim ImportDate As Integer
    Dim FileLocation As String
    Dim x As Integer
    
    Application.StatusBar = "Please Select the file to Import..."
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlManual
    
    'Import the driver trip report sheet
    FileLocation = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
    '::: IMPORT THE DATA INTO THE TEMPLATE :::
    
    Set DCSwb = ActiveWorkbook
    Application.StatusBar = "Importing File..."
    
    'Opens the file the user specified
    Set ImportWb = Workbooks.Open(Filename:=FileLocation)
    
    For x = 1 To ImportWb.Sheets.Count
        ImportWb.Sheets(x).Copy After:=DCSwb.Sheets("Control Panel")
    Next
    
    ImportWb.Close savechanges:=False
    
    Application.StatusBar = Null
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

 

[Lizard07]

That worked perfectly - thanks!