Import from a closed workbook into a specific worksheet

Lawrence Salvucci
Lawrence Salvucci used Ask the Experts™
on
I have this code that imports data from a closed workbook but I need to specify which sheet to import it to. Right now it will import to the active sheet. I want to specify the sheet it does to.

Sub LoadDataFromWorkbook03()
    On Error Resume Next
    On Error GoTo 0

Dim tArray As Variant, r As Long, c As Long
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(n, "A").Select
    tArray = ReadDataFromWorkbook("D:\Operations\Performance\Data\Sales\MTD Sales PC03", "A2:P15000")
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
Application.Calculation = xlAutomatic
    On Error Resume Next
    
    On Error GoTo 0
End Sub

Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
    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 & "]")
    On Error GoTo 0
    ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Function
InvalidInput:
    MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
    Set rs = Nothing
    Set dbConnection = Nothing
End Function

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2011

Commented:
Try this and let me know
Sub LoadDataFromWorkbook03()
    On Error Resume Next
    On Error GoTo 0
Dim myws As Worksheet
mysheet = "TEST"  'You specify your worksheet here
Set myws = Application.ActiveWorkbook.Sheets(mysheet)

Dim tArray As Variant, r As Long, c As Long
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(n, "A").Select
    tArray = ReadDataFromWorkbook("D:\Operations\Performance\Data\Sales\MTD Sales PC03", "A2:P15000")
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            myws.Cells.Range("A2").Activate 'You specify where you want the active cell to be
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
Application.Calculation = xlAutomatic
    On Error Resume Next
    
    On Error GoTo 0
End Sub

Open in new window

Lawrence SalvucciDirector of Information Technology

Author

Commented:
I'm getting an error:

Activate method of Range class failed.

I don't want to specify what the active cell is. I just want the code to import it to my "detail" worksheet, not the worksheet I am currently on. This way if I'm on another worksheet and I run the macro it will import to the "detail" worksheet always.
Top Expert 2011

Commented:
OK, try this - you need to activate at least a cell so your other array formula to work.

Sub LoadDataFromWorkbook03()
    On Error Resume Next
    On Error GoTo 0
Dim myws As Worksheet
mysheet = "detail"  'You specify your worksheet here
Set myws = Application.ActiveWorkbook.Sheets(mysheet)

Dim tArray As Variant, r As Long, c As Long
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(n, "A").Select
    tArray = ReadDataFromWorkbook("D:\Operations\Performance\Data\Sales\MTD Sales PC03", "A2:P15000")
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            myws.Range("A1").Activate 'You specify where you want the active cell to be
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
Application.Calculation = xlAutomatic
    On Error Resume Next
    
    On Error GoTo 0
End Sub

Open in new window

Amazon Web Services

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Lawrence SalvucciDirector of Information Technology

Author

Commented:
Still getting the same error message on this line of code:

myws.Range("A1").Activate 'You specify where you want the active cell to be
Top Expert 2011

Commented:
OK I see...maybe it is better to set the active cell outside the loop...
try this please
Sub LoadDataFromWorkbook03()
    On Error Resume Next
    On Error GoTo 0
Dim myws As Worksheet
mysheet = "DETAIL"  'You specify your worksheet name, need to insert exact name here
Set myws = Application.ActiveWorkbook.Sheets(mysheet)

Dim tArray As Variant, r As Long, c As Long
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(n, "A").Select
myws.Select
myws.Activate
myws.Range("A2").Select
myws.Range("A2").Activate 'You specify where you want the active cell to be
tArray = ReadDataFromWorkbook("D:\Operations\Performance\Data\Sales\MTD Sales PC03", "A2:P15000")
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
Application.Calculation = xlAutomatic
    On Error Resume Next
    
    On Error GoTo 0
End Sub

Open in new window

Top Expert 2011

Commented:
if this does not work I will need a small sample of your MTD Sales file so I can have the same data and try to recreate the reading of the array into the spreadsheet, ok?
Lawrence SalvucciDirector of Information Technology

Author

Commented:
That worked but the problem now is I want it to copy this data to the first blank row on my "detail" worksheet. Right now it's overwriting everything starting from row A2. I need it to add this data to the first blank row so it doesn't overwrite the existing data.
Top Expert 2011

Commented:
OK, we need a small function to find the first blank row, cell A<blankrow> correct?
Top Expert 2011
Commented:
Here goes try this...it will select the first empty cell in the first empty row

Sub LoadDataFromWorkbook03()
    On Error Resume Next
    On Error GoTo 0
Dim myws As Worksheet
Dim MyRange As Range
mysheet = "DETAIL"  'You specify your worksheet name, need to insert exact name here
Set myws = Application.ActiveWorkbook.Sheets(mysheet)

Dim tArray As Variant, r As Long, c As Long
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(n, "A").Select
myws.Select
myws.Activate
Set MyRange = ws.UsedRange.End(xlDown).Offset(1, 0)
MyRange.Select
MyRange.Activate 'First empty row, first cell selected
tArray = ReadDataFromWorkbook("D:\Operations\Performance\Data\Sales\MTD Sales PC03", "A2:P15000")
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
Application.Calculation = xlAutomatic
    On Error Resume Next
    
    On Error GoTo 0
End Sub

Open in new window

Lawrence SalvucciDirector of Information Technology

Author

Commented:
Getting an error that says:

"Object Required"

It goes to this line in the code:

Set MyRange = ws.UsedRange.End(xlDown).Offset(1, 0)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial