更改ActiveCell以使用来自各个工作簿的数据更新工作表

Question

我有多个工作簿，其中以发票格式列出了发票信息。

我需要提取各种数据并编译可以导入到另一个软件中的工作表。

这是我编写的代码：

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

问题是我无法更改ActiveCell。它将在工作表的第一个单元格中输入数据，然后不提取其他任何数据。

注意：我试图在Mac上执行此操作。

Answer 1

未经测试，但您看到了如何不使用ActiveCell / Activate等的方式可以工作：

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