如何使用VBA将已关闭工作簿中的数据(保持关闭状态)复制到主工作簿中? [英] How to copy data from closed workbooks (keeping them closed) into master workbook using VBA?
本文介绍了如何使用VBA将已关闭工作簿中的数据(保持关闭状态)复制到主工作簿中?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我需要使用VBA将关闭的工作簿中的数据复制(而不打开它们)到主工作簿中。
I need to copy data from closed workbooks, without opening them, into a master workbook using VBA.
我使用 Workbooks.Open
上的4-6个文件。每个需要打开的文件都会大大降低复制操作的速度。
I use Workbooks.Open
on from 4-6 files. Each file that needs to open dramatically slows the copy operation.
我需要高效的VBA代码来复制数据,而无需打开每个文件。
I need efficient VBA code for copying data without opening each file.
以下是我的代码示例:
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
推荐答案
尝试一下。它可以在不打开源文件的情况下使用ADO进行工作:
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
这篇关于如何使用VBA将已关闭工作簿中的数据(保持关闭状态)复制到主工作簿中?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文