How to copy data from closed workbooks (keeping them closed) into master workbook using VBA?

Question

I need to copy data from closed workbooks, without opening them, into a master workbook using VBA.

I use Workbooks.Open on from 4-6 files. Each file that needs to open dramatically slows the copy operation.

I need efficient VBA code for copying data without opening each file.

Here is an example of my code:

Set x = Workbooks.Open("C:\Bel.xls")
'Now, copy what you want from x:
x.Sheets("Daily Figures").Range("A13:j102").Copy
'Now, paste to y worksheet
y.Activate
Sheets("Data - Daily").Range("N2").PasteSpecial
'Close x:
Application.CutCopyMode = False
x.Close
Sheets("sheet1").Range("M4") = Date

try- `y.Sheets("Data - Daily").Range("N2").PasteSpecial`- then look into `application.screenupdating=false` before you open the workbook — Davesexcel, Mar 27 '15 at 21:54
You typically are better off opening the workbooks from a control perspective that the normal "closed" methods of xlm macros, ADO and creating direct links. As an example ADO can have issues with mixed data types — brettdj, Mar 28 '15 at 08:10
Also, try using Application.EnableEvents = false and Application.EnableEvents = true . Each time you do a paste, an event is being fire. Application.EnableEvents = false can improve the speed. — El Scripto, Mar 28 '15 at 11:37
http://stackoverflow.com/questions/7524064/excel-vba-question-need-to-access-data-from-all-excel-files-in-a-directory-wi/7524229#7524229 — brettdj, Mar 28 '15 at 19:27

Yan F. · Accepted Answer · 2015-03-28T02:23:04.287

Try this. It works using ADO without opening a source file:

Sub TransferData()
Dim sourceFile As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

sourceFile = "C:\Bel.xls"

GetData sourceFile, "Daily Figures", "A13:j102", Sheets("Data - Daily").Range("N2"), False, False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Public Sub GetData(sourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
' http://www.rondebruin.nl/ado.htm

Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

' Create the connection string.
If Header = False Then
    If Val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & sourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=No"";"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & sourceFile & ";" & _
                    "Extended Properties=""Excel 12.0;HDR=No"";"
    End If
Else
    If Val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & sourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=Yes"";"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & sourceFile & ";" & _
                    "Extended Properties=""Excel 12.0;HDR=Yes"";"
    End If
End If

If SourceSheet = "" Then
    ' workbook level name
    szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
    ' worksheet level name or range
    szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

' Check to make sure we received data and copy the data
If Not rsData.EOF Then

    If Header = False Then
        TargetRange.Cells(1, 1).CopyFromRecordset rsData
    Else
        'Add the header cell in each column if the last argument is True
        If UseHeaderRow Then
            For lCount = 0 To rsData.Fields.Count - 1
                TargetRange.Cells(1, 1 + lCount).Value = _
                rsData.Fields(lCount).Name
            Next lCount
            TargetRange.Cells(2, 1).CopyFromRecordset rsData
        Else
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        End If
    End If

Else
    MsgBox "No records returned from : " & sourceFile, vbCritical
End If

' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & sourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub

I use the same GetData function to retrieve data from a closed file. However, Excel keeps complaining about "External Table is not in the expected format". If, on the other hand, I keep the file that the data is copied from open, the function just works as it should be. — fnisi, Nov 23 '16 at 21:10
For some reason, `GetData` does not work for Excel12 (.xlsx) extension — fnisi, Nov 23 '16 at 23:31
maybe it should check to see if the filetype is xlsx to determine which connection string to use. — KySoto, Aug 17 '18 at 18:54

How to copy data from closed workbooks (keeping them closed) into master workbook using VBA?

1 Answers1

Linked

Related