Change ActiveCell to update a worksheet with data from various workbooks

Question

I have multiple workbooks with invoice information laid out in an invoice format.

I need to extract various pieces of data and compile a worksheet that can be imported into another software.

Here is the code I have written:

Sub GetFile()

Dim fNameAndPath As Variant
Dim wbdata As Workbook
Dim wbsource As Workbook
Dim ShToCopy As Worksheet
Dim rangedata As Range

'set data workbook
Set wbdata = ThisWorkbook
Set rangedata = ActiveCell

'open other workbook and set as source workbook

fNameAndPath = Application.GetOpenFilename
If fNameAndPath = False Then Exit Sub
Set wbsource = Workbooks.Open(fNameAndPath)
Set ShToCopy = wbsource.Worksheets("PCO #")


Call Extract_Invoice_Data_1(wbdata, wbsource, ShToCopy, rangedata)
Call Extract_Invoice_Data_2(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_3(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_4(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_5(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_6(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_7(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_8(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_9(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_10(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_11(wbdata, wbsource, ShToCopy)


wbsource.Close SaveChanges:=False
Set wbsource = Nothing

End Sub

Sub Extract_Invoice_Data_1(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet, rangedata As Range)

    rangedata.Value = ShToCopy.Range("G5").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_2(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G4").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_3(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C3").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_4(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C4").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_5(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C5").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_6(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C6").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_7(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G32").Value
    ActiveCell.Offset(0, 1).Activate

End Sub


Sub Extract_Invoice_Data_8(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G25").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_9(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G28").Value
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=RC[-1]*0.15"
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_10(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G21").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_11(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G22").Value
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=RC[-1]*0.15"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=SUM(RC[-4]:RC[-1])"
    ActiveCell.Offset(0, 1).Activate

End Sub

The problem is I can't change ActiveCell. It will enter the data in the first cell of the worksheet and then not extract any of the other data.

Note: I am attempting to execute this on a Mac.

Have you stepped through this in the debugger? I'd suggest reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/q/10714251/4088852) and starting over. — Comintern, Nov 18 '18 at 16:35
No. I don't know how to step through it in debugger. This is actually the third time I have put something together, so I have already started over three times. Would you have a suggestion for how to do it better on my fourth try? My main problem is I don't have a clue how else to move through the cells while copying in a pasting from the other workbook. Thank you! — Tonya Schulte, Nov 18 '18 at 22:47

score 1 · Accepted Answer · answered Nov 19 '18 at 04:05

Untested but you see how this can work without using ActiveCell/Activate etc:

Sub ChooseInputFileAndExtractData()

    Dim fNameAndPath As Variant
    Dim wbsource As Workbook
    Dim destRow As Range

    Set destRow = ActiveCell.EntireRow  'get the selected Row

    'open other workbook and set as source workbook
    fNameAndPath = Application.GetOpenFilename
    If fNameAndPath <> False Then
        Set wbsource = Workbooks.Open(fNameAndPath)

        ExtractInvoiceData destRow, wbsource.Worksheets("PCO #")

        wbsource.Close SaveChanges:=False
        Set wbsource = Nothing
    End If

End Sub

Sub ExtractInvoiceData(destRow As Range, SourceSheet As Worksheet)
    With destRow
        .Cells(1).Value = SourceSheet.Range("G5").Value
        .Cells(2).Value = SourceSheet.Range("G4").Value
        .Cells(3).Value = SourceSheet.Range("C3").Value
        .Cells(4).Value = SourceSheet.Range("C4").Value
        .Cells(5).Value = SourceSheet.Range("C5").Value
        .Cells(6).Value = SourceSheet.Range("C6").Value
        .Cells(7).Value = SourceSheet.Range("G32").Value
        .Cells(8).Value = SourceSheet.Range("G25").Value
        .Cells(9).Value = SourceSheet.Range("G28").Value
        .Cells(10).FormulaR1C1 = "=RC[-1]*0.15" '
        'etc etc you get the idea
    End With
End Sub

Change ActiveCell to update a worksheet with data from various workbooks

1 Answers1