如何使用VBA将closures的工作簿中的数据（保持closures状态）复制到主工作簿中
我需要帮助，从几个封闭的工作簿，而不打开它们，复制到使用VBA主工作簿的数据。 今天我使用的functionWorkbooks.open为了这样做，虽然我使用4-6文件来复制数据，每个需要打开的文件 – 显着减慢复制操作。
我需要帮助使用有效的VBA代码复制数据，而无需打开每个文件。
这里是我的代码的一个例子：
Set x = Workbooks.Open("C:\Bel.xls") 'Now, copoy 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 请提前帮忙谢谢，
尝试这个。 它使用ADO而不打开源文件：
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