Import Data from closed Workbooks - Help

[vadius]

Hi all,

I am looking to import a sheet into an opened workbook. I have found a code from this URL http://www.erlandsendata.no/english/index.php?d=envbatextimportwb , but I can't manage to get this done correctly. I want to copy the range "A1:Z1000" from the "Source" sheet to the target sheet "Div_P&L" (which will be opened when the macro is run) located in another folder.

Source address : "H:\P&L\YE Temp\Div P&L\P&L Report 020312.xls" , sheet("Source"), data = range("A1:Z1000").
Target address : "H:\Yield Enhancement\PandL.xls" , sheet("Div_P&L") , data = range ("A1")

Line Workbooks(PandL).Activate => Run time error 9, Subscript out of range.

Has anyone any idea ?

I have tried the getvalue function which works, but it takes a long time. So I want to use an ADO way.

Thanks a lot

Sub importdata()
ImportRangeFromWB "H:\P&L\YE Temp\Div P&L\P&L Report 020312.xls", "Source", "A1:Z1000", True, "PandL.xls", "Div_P&L", "A1"
End Sub

Sub ImportRangeFromWB(SourceFile As String, SourceSheet As String, _
    SourceAddress As String, PasteValuesOnly As Boolean, _
    TargetWB As String, TargetWS As String, TargetAddress As String)
' Imports the data in Workbooks(SourceFile).Worksheets(SourceSheet).Range(SourceAddress)
' to Workbooks(TargetWB).Worksheets(TargetWS).Range(TargetAddress)
' Replaces existing data in Workbooks(TargetWB).Worksheets(TargetWS)
' without prompting for confirmation
' Example
' ImportRangeFromWB "C:\FolderName\TargetWB.xls", _
    "Sheet1", "A1:E21", True, _
    ThisWorkbook.Name, "ImportSheet", "A3"

Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range
Dim TargetRange As Range, A As Integer, tString As String
Dim r As Long, c As Integer
    ' validate the input data if necessary
    If Dir(SourceFile) = "" Then Exit Sub ' SourceFile doesn't exist
    Set SourceWB = Workbooks.Open(SourceFile, True, True)
    Application.StatusBar = "Reading data from " & SourceFile
    
    Workbooks(PandL).Activate
    Worksheets("Div_P&L").Activate
    
    ' perform import
    Set TargetRange = Range(TargetAddress).Cells(1, 1)
    Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress)
    For A = 1 To SourceRange.Areas.Count
        SourceRange.Areas(A).copy
        If PasteValuesOnly Then
            TargetRange.PasteSpecial xlPasteValues
            TargetRange.PasteSpecial xlPasteFormats
        Else
            TargetRange.PasteSpecial xlPasteAll
        End If
        Application.CutCopyMode = False
        If SourceRange.Areas.Count > 1 Then
            Set TargetRange = _
                TargetRange.offset(SourceRange.Areas(A).Rows.Count, 0)
        End If
    Next A
    
    ' clean up
    Set SourceRange = Nothing
    Set TargetRange = Nothing
    Range(TargetAddress).Cells(1, 1).Select
    SourceWB.Close False
    Set SourceWB = Nothing
    Application.StatusBar = False
End Sub

 

[vadius]

This code does what I want, but it does not copy the figures...only the text

Has anyone an idea ?

Thanks

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
    TargetRange As Range, IncludeFieldNames As Boolean)
    
'GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False
'GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range("B3"), True
    
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer

    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
        "ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    Set TargetCell = TargetRange.Cells(1, 1)
    If IncludeFieldNames Then
        For i = 0 To rs.Fields.Count - 1
            TargetCell.offset(0, i).Formula = rs.Fields(i).Name
        Next i
        Set TargetCell = TargetCell.offset(1, 0)
    End If
    TargetCell.CopyFromRecordset rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set TargetCell = Nothing
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Sub
InvalidInput:
    MsgBox "The source file or source range is invalid!", _
        vbExclamation, "Get data from closed workbook"
End Sub

Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell.
GetDataFromClosedWorkbook "H:\P&L\YE Temp\Div P&L\P&L Report 020312.xls", "A1:Z1000", Range("A1"), False
End Sub

 

[Norie]

You aren't passing a variable called PandL to the function so on the line the error ocurrs on it's empty.

Which worksheet are you trying to refer to with PandL?

By the way, this import could be done like this.

Sub ImportData()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
 
 
       Set wbSource = Workbooks.Open("H:\P&L\YE Temp\Div P&L\P&L Report 020312.xls")
   
       Set wbTarget = Workbooks.Open("H:\Yield Enhancement\PandL.xls")
 
       Set wsSource = wbSource.Worksheet("Source")
 
       Set wsTarget =  wbTarget.Worksheets("Div_P&L")
 
       wsSource.Range("A1:Z1000").Copy wsTarget.Range("A1")
 
       ' close workbooks if required
 
       wbSource.Close
       wbTarget.Close SaveChanges:=False
 
End Sub

Note, this assumes both workbooks are closed.

If the target book is open you can use this.

Set wbTarget =ThisWorkbook