Excel: incorporate last row code into procedure

[ron513]

Hello,
The code below is executed from a workbook (WB1), the user selects a workbook (WB2), it loops through all sheets and copies values from specific cells in WB2 to WB1.
The values from each sheet of WB2 will be entered in a new row on WB1, starting on row 3.
I would like to alter the code to start on the first blank row, so existing data it is not overwritten.
I have attempted unsuccessful to use the statement, LastRow = ActiveSheet.UsedRange.Rows.Count. I don’t know if the problem is my code or my placement of it within the procedure.
Note: WB1 and WB2 are only used in this description to make it easier to understand, I hope.

Thanks for the assistance.

Ron

Sub ImportBOE()

    Dim wb As Workbook, fullName As String, fileName As String
    Dim i As Long, fileToOpen As Variant
    Dim rCount As Integer

    On Error Resume Next

    fileToOpen = Application.GetOpenFilename("Excel files (*.xls), *.xls")
    fullName = fileToOpen
    fileName = Dir(fileToOpen)

    If IsWbOpen(fileName) Then
        Set wb = Workbooks(fileName)
    Else
        Set wb = Workbooks.Open(fullName)
    End If
    rCount = 3 'starting row
    For i = 1 To wb.Worksheets.Count
        With ThisWorkbook.Sheets("Resources (Spread or Load)")
            .Cells(rCount, 1).Value = wb.Sheets(i).Cells(2, 4).Value 'Task ID
            .Cells(rCount, 2).Value = wb.Sheets(i).Cells(5, 2).Value 'Resource ID
            .Cells(rCount, 12).Value = wb.Sheets(i).Cells(7, 6).Value 'Spread
            .Cells(rCount, 5).Value = wb.Sheets(i).Cells(3, 2).Value 'WBS
             .Cells(rCount, 13).Value = wb.Sheets(i).Cells(6, 8).Value 'Hours
            .Cells(rCount, 14).Value = wb.Sheets(i).Cells(7, 2).Value 'Start date
            .Cells(rCount, 15).Value = wb.Sheets(i).Cells(7, 4).Value 'End date
        End With
         rCount = rCount + 1
    Next i
Workbooks(fileName).Close

End Sub

Public Function IsWbOpen(wbName As String) As Boolean
    On Error Resume Next
    IsWbOpen = Len(Workbooks(wbName).Name)
End Function

 

[SkipVought]

Hi,

As long as your data is contiguous to A1...

lNextRow = YourSheet.[A1].CurrentRegion.rows.count + 1

Skip,

_[red][/red]

 

[firefytr]

That code looks veeery familiar..

Check out FAQ2112, just be sure to change the reference from ActiveSheet to the workbook/worksheet in question. If you fully qualify your references and point the exact way for your procedure to look, you'll have no problems.

That would turn your code into something like this ...

Sub ImportBOE()

    Dim wb As Workbook, ws As Worksheet, fullName As String, fileName As String
    Dim i As Long, fileToOpen As Variant
    Dim rCount As Long    'use instead of Integer when counting

    On Error Resume Next
    fileToOpen = Application.GetOpenFilename("Excel files (*.xls), *.xls")
    If TypeName(fileToOpen) = "Boolean" Then
        MsgBox "You pressed Cancel.", vbInformation, "ERROR!"
        Exit Sub
    End If
    fullName = fileToOpen
    fileName = Right(fileToOpen, Len(fileToOpen) - InStrRev(fileToOpen, Application.PathSeparator))
    If IsWbOpen(fileName) Then
        Set wb = Workbooks(fileName)
    Else
        Set wb = Workbooks.Open(fullName)
    End If
    Set ws = ThisWorkbook.Sheets("Resources (Spread or Load)")
    rCount = ws.Range("A:A").Find("*", after:=ws.Cells(1, 1), lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    For i = 1 To wb.Worksheets.Count
        ws.Cells(rCount, 1).Value = wb.Sheets(i).Cells(2, 4).Value    'Task ID
        ws.Cells(rCount, 2).Value = wb.Sheets(i).Cells(5, 2).Value    'Resource ID
        ws.Cells(rCount, 12).Value = wb.Sheets(i).Cells(7, 6).Value    'Spread
        ws.Cells(rCount, 5).Value = wb.Sheets(i).Cells(3, 2).Value    'WBS
        ws.Cells(rCount, 13).Value = wb.Sheets(i).Cells(6, 8).Value    'Hours
        ws.Cells(rCount, 14).Value = wb.Sheets(i).Cells(7, 2).Value    'Start date
        ws.Cells(rCount, 15).Value = wb.Sheets(i).Cells(7, 4).Value    'End date
        rCount = rCount + 1
    Next i
    wb.Close savechanges:=False

End Sub

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[ron513]

Thanks Skip and Zack,

I’m always amazed at the quick responses from this group.

Zack,

It works great thanks again.
It should look familiar, it is mostly your code after you did an overhaul on mine a while back. All but using Integer of course.
The faq you reference is great stuff.

Ron

 

[firefytr]

The FAQ I tried to link didn't link too well..

http://www.tek-tips.com/faqs.cfm?fid=2112

Glad it's working for you Ron.

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci