Question

我有一个sub，它在SolutionID列中查找与一个表中的值数组匹配的值，然后将其复制到另一个表中。

但是，我在使用.PasteSpecial方法 -

时遇到错误

Object不支持此属性或方法

有人知道我做错了什么吗？感谢。

Private Sub CopySolutions(ByRef SourceTable As ListObject, ByRef DestinationTable As ListObject, ByRef values() As String)

    On Error Resume Next

    Dim i, j As Integer ' Dummy for looping

    '** Loop through all of the ID's to copy... *'
    For i = LBound(values) To UBound(values)

        With SourceTable.DataBodyRange

            For j = 1 To .Rows.Count

                If .Cells(j, 1).Value = values(i) Then

                    .Rows(j).Copy   ' Copy the row in the SourceTable

                    Dim LastRow As Integer

                    LastRow = DestinationTable.Rows.Count   ' Work out the number of rows in the DestinationTable

                    '** Check to see if the last row in the destination table is already empty '*
                    If DestinationTable.DataBodyRange.Cells(LastRow, 1).Value <> "" Or LastRow = 0 Then
                        DestinationTable.ListRows.Add AlwaysInsert:=True    ' Insert a new row in to the DestinationTable
                        LastRow = LastRow + 1                               ' Increment LastRow to take in to account the newly added row
                    End If

                    DestinationTable.DataBodyRange.Cells(LastRow, 1).Select       ' Select the last row, column 1 in the Destination Table
                    Selection.PasteSpecial Paste:=xlPasteValues, _
                                           Operation:=xlNone, _
                                           SkipBlanks:=False, _
                                           Transpose:=False         ' Paste the copied row

                    Exit For    ' Exit the For, there is no need to keep checking for matches

                End If

            Next

        End With

    Next

    If Err.Number <> 0 Then
        Call ErrorOutput("An error occured while copying your selected solutions.")
    End If
    On Error GoTo 0

    WS.Range("Solution").Select ' Reselect the Solution cell range

End Sub

Answer 1

最好避免复制/粘贴：

Dim rngSrc as Range
'...
Set rngSrc = .Rows(j)
'...

DestinationTable.DataBodyRange.Cells(LastRow, 1). _
         Resize(1, rngSrc.Columns.Count).Value = rngSrc.Value

Answer 2

试试这个：

SourceTable.DataBodyRange.Rows(j).Copy DestinationTable.DataBodyRange.Range("A" & CStr(lastRow))

找到最后一排后的课程。这样您就不必使用.Select

PasteSpecial不起作用

2 个答案: