VBA:来自已关闭工作簿的IMPORT数据

时间:2017-05-29 08:54:11

标签: excel vba excel-vba import copy

我没有找到解决这个问题的明确方法。

我想将已关闭Ws.Data的所有数据复制到有效CurrentWs.Data。你们有什么想法怎么做?

2 个答案:

答案 0 :(得分:1)

尝试使用ADODB连接:

Sub copyFromWs()
Dim Cnx As ADODB.Connection
Dim fileToCopy As String
Dim SheetName As String, request_SQL As String
Dim Rst As ADODB.Recordset


fileToCopy = "C:\monClasseurBase.xls" 'here you can use something like ws.data.pathname
SheetName = "Sheet1" 'Here it's your ws.Data
Set Cnx = New ADODB.Connection

'Connection
With Cnx
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & filetocopy & _
        ";Extended Properties=Excel 8.0;"
    .Open
End With


'Request
request_SQL= "SELECT * FROM [" & SheetName & "$]"

Set Rst = New ADODB.Recordset
Set Rst = Cnx.Execute(request_SQL)

Range("A1").CopyFromRecordset Rst 
'Here for you something like currentws.Data.Range("A1").CopyFromRecordset Rst

'Close
Cnx.Close
Set Cnx = Nothing
End Sub

答案 1 :(得分:0)

此链接非常适合从已关闭的工作簿中复制数据。

https://www.rondebruin.nl/win/s3/win024.htm

或者,试试这个。

Sub ImportDatafromcloseworkbook()
'Update 20150707
Dim xWb As Workbook
Dim xAddWb As Workbook
Dim xRng1 As Range
Dim xRng2 As Range
Set xWb = Application.ActiveWorkbook
xTitleId = "KutoolsforExcel"
With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        Application.Workbooks.Open .SelectedItems(1)
        Set xAddWb = Application.ActiveWorkbook
        Set xRng1 = Application.InputBox(prompt:="Select source range", Title:=xTitleId, Default:="A1", Type:=8)
        xWb.Activate
        Set xRng2 = Application.InputBox(prompt:="Select destination cell", Title:=xTitleId, Default:="A1", Type:=8)
        xRng1.Copy xRng2
        xRng2.CurrentRegion.EntireColumn.AutoFit
        xAddWb.Close False
    End If
End With
End Sub