Question

我只需要从一张纸上抓取一列（范围），然后附加到另一张纸上即可。出于某种原因，一直收到错误1004 - 试图运行粘贴值函数当对象/应用定义的错误

。

任何帮助将不胜感激。

    Sub copycontactsiratotpsd()

    Dim LastRowIRA2 As Long
    Dim LastRowIRA As Long
    Dim LastRowPOV As Long
    Dim lastrow As Long




    'activate source sheet
    ActiveWorkbook.Worksheets("IRA").Activate

    'copy from rev to ira AG to match # of rows for TPRM Contacts before appending
    ActiveWorkbook.Sheets("Rev").Range("B2:B15000").SpecialCells(xlCellTypeVisible).Copy
    ActiveWorkbook.Sheets("IRA").Range("AG2:AG15000").PasteSpecial xlPasteValues

    'define last rows for all three instances
    LastRowIRA = ActiveSheet.Range("A1").CurrentRegion.Rows.count
    LastRowIRA2 = ActiveSheet.Range("AG1").CurrentRegion.Rows.count
    lastrow = WorksheetFunction.Max(Sheets("TPD").Cells(Rows.count, "A").End(xlUp).Row)

    LastRowPOV = ActiveWorkbook.Sheets("TPD").Range("A1").CurrentRegion.Rows.count

    'if the number of lastrow in source sheet is equal to total VISIBLE last row within reference sheet then
        If LastRowIRA = LastRowIRA2 Then

            ActiveWorkbook.Worksheets("IRA").Activate

            'copy the data needed, values are generally less than 10000 rows
            ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy

            ActiveWorkbook.Sheets("TPD").Range("A", lastrow).PasteSpecial xlPasteValues

'LINE WITH ERROR ABOVE




        'else display msg for error handling
        Else: MsgBox "Row Count is off! *CHECK*"

        End If


    ActiveWorkbook.Worksheets("IRA").Activate
    Columns(33).EntireColumn.Delete

    End Sub

Answer 1

要允许回答以解决此问题，请执行以下操作：

ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Cells(lastrow, "A").PasteSpecial xlPasteValues

或者：

ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Range("A" & lastrow).PasteSpecial xlPasteValues

将数据追加到另一个工作表的最后一行

1 个答案: