Importing multiple worksheets

Question

I use the following code to import multiple worksheets from another workbook and do some processing. The importing time is too long. Can anyone suggest a more efficient way to import? Should I be looking into more information in the source files for copy? Can anyone please suggest a way to speed up the import function?

I am not a professional developer, so I might have left out some key points to note. Please let me know if I need to look into something else, as well.

Sub SKR_Import()
On Error GoTo errorhandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sht As Worksheet
Set wb1 = ActiveWorkbook
Dim fd As FileDialog
Dim filechosen As Integer
Dim filename As String
Dim i As Long
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.AllowMultiSelect = True
fd.Title = "Select Excel workbooks to import all sheets"
filechosen = fd.Show
If filechosen = -1 Then
    For i = 1 To fd.SelectedItems.Count
        Set wb2 = Workbooks.Open(fd.SelectedItems(i))
        For Each Sht In wb2.Sheets
            Sht.Activate
            ActiveSheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)
        Next Sht
        wb2.Close SaveChanges:=False
    Next i
End If
wb1.Activate
Application.ScreenUpdating = True
Exit Sub
errorhandler:
msgBox Error, vbCritical, "Error"
wb2.Close SaveChanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

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 & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Error"
    wB2.Close SaveChanges:=False
    Resume ProperExit
End Sub

Answer 2

That looks like normal code to me. Except you don't need .Activate and Activesheet, just sht.copy. Or instead of a loop, do it all at once:

wb2.Sheets.copy After:=wb1.Sheets(wb1.Sheets.Count)

What do you think of as slow? IF the workbooks you are opening are large or contain macros or slow calculations, I would turn off EnableEvents so their workbook_open macros don't fire, and turn calc to manual at the start, and open the workbooks read-only.

p.s. just seen R3UK answered while I was typing. What they said.

P.P.S: (Thanks for the edit Graipher, I didn't know about those backticks for code)

Also, if the source workbooks are just raw data, that's fine, and you can use the recordset idea too, but if they have formulas, then rather than accumulating huge amounts of external link formulas by simply copying the sheet, another approach you could time for comparison is to use copy the source .UsedRange and then add a target sheet and .PasteSpecial xlValuesAndNumberFormats.

Answer 3

If the worksheets you are copying contain data only, you could try creating a recordset of each worksheet something like:

Dim rs As New ADODB.Recordset
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command

    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0" 'Microsoft.ACE.OLEDB.12.0 for Excel 2013
       .ConnectionString = "Data Source='" & [workbook containing worksheet].FullName & _
"'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'" 'Excel 12.0 Xml for Excel 2013
       .Open
   End With

   Set cmd.ActiveConnection = con
   cmd.CommandType = adCmdText
   cmd.CommandText = "SELECT * FROM [" & [name of sheet you want to copy] & "$]"
   rs.CursorLocation = adUseClient
   rs.CursorType = adOpenDynamic
   rs.LockType = adLockOptimistic

   rs.Open cmd

Then:

Dim rng as Range
Set rng = ActiveSheet.Range("A1")
rng.CopyFromRecordSet(rs)

I haven't tried this and the code isn't complete (ie object clean up), but I think you get the idea. You could then create an array of workbooks and worksheets and loop through it pulling in the data from each worksheet into a new sheet in the workbook from which you are calling the code. In my experience working with record sets is fairly quick. Faster then copying.

Answer 4

you can exploit the Copy() method of Sheets object and thus avoid looping through Sheets collection itself

wB2.Sheets.Copy after:=wb1.Sheets(wb1.Sheets.Count)

you also can take advantage of:

• the With - End With syntax

  to reference an object once for all

• ActiveWorkbook

  this with proper care, since it's easy to get cheated by the really "Active" workbook

both to reduce the burden of declaring and setting objects, like follows:

Option Explicit

Sub SKR_Import()
    Dim CalcMode As Long
    Dim i As Long

    BoostOn CalcMode

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select Excel workbooks to import all sheets"
        If .Show = -1 Then
            On Error GoTo ErrorHandler
            For i = 1 To .SelectedItems.Count
                Workbooks.Open(fD.SelectedItems(i), , True).Sheets.Copy after:=Sheets(Sheets.Count) 
                ActiveWorkbook.Close SaveChanges:=False
            Next i
        End If
    End With

ErrorHandler:
    On Error GoTo 0
    BoostOff CalcMode
End Sub

Sub BoostOn(CalcMode As Long)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .DisplayStatusBar = False
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
    End With
End Sub

Sub BoostOff(CalcMode As Long)
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .DisplayStatusBar = True
        .Calculation = CalcMode
    End With
End Sub

Here can be useful some notes on these stataments:

Workbooks.Open(fD.SelectedItems(i), , True).Sheets.Copy after:=Sheets(Sheets.Count)
ActiveWorkbook.Close SaveChanges:=False

where:

Sheets(Sheets.Count)

is implicitly referring to the ActiveWorkbook which, right before opening the new workbook, i.e. before the first statement is completed, is still what you had currently active at the moment you called the macro.

once you pass that statement the ActiveWorkbook becomes the newly opened one so the second statement will close it