运行-时间错误“1004”：范围 class 的 PasteSpecial 方法在尝试将具有匹配条件的行从一个 table 复制到另一个时失败

Question

我有一个存储大量数据的工作簿。我正在尝试导入每周报告，将其粘贴到 table 中，循环导入的信息，如果某行在第二个 table 中与问题键不匹配，则需要复制该行并且粘贴到第二个 table.

一切正常，直到到达代码的粘贴部分。选区似乎没有复制？我尝试了几种故障排除方法，但 none 都奏效了。

Sub Get_Data_From_File()

    Dim FileToOpen As Variant
    Dim DAHelpPulse As Workbook
    Application.ScreenUpdating = False

    FileToOpen = Application.GetOpenFilename(Title:="Browse & Import Jira Pulse Check", FileFilter:="Excel Files(*.xls*),*xls*")
    
    If FileToOpen <> False Then
        
        Set DAHelpPulse = Application.Workbooks.Open(FileToOpen)
        DAHelpPulse.Sheets(1).Range("A2", Range("M2").End(xlDown)).Copy
        ThisWorkbook.Worksheets("Import").Visible = True
        ThisWorkbook.Worksheets("Import").Range("A2").PasteSpecial xlPasteValues
        DAHelpPulse.Close False
        SearchandExtract
        
    End If
    
    Application.ScreenUpdating = False
    
End Sub

Sub SearchandExtract()

    Dim datasheet As Worksheet
    Dim ticketsheet As Worksheet
    Dim homesheet As Worksheet
    Dim issuekey As String
    Dim finalrow As Integer
    Dim i As Integer
    Dim LastRow As Range
    Dim TicketReviewTable As ListObject
    
    Set datasheet = Sheet9
    Set ticketsheet = Sheet2
    Set homesheet = Sheet6
    issuekey = ticketsheet.Range("B2").Value
    
    datasheet.Select
    finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To finalrow
    
        If Cells(i, 2) <> issuekey Then
        Range(Cells(i, 1), Cells(1, 13)).Select
        Selection.Copy
        Sheet2.ListObjects("TicketReview").ListRows.Add
        Set TicketReviewTable = Sheet2.ListObjects("TicketReview")
        Set LastRow = TicketReviewTable.ListRows(TicketReviewTable.ListRows.Count).Range
        With LastRow
        LastRow.PasteSpecial xlPasteValues
        End With
        datasheet.Select

        End If
    
    Next i
    
    homesheet.Select
    
End Sub

Answer 1

我认为您真的不需要将它分成两个子部分 - 这只是意味着您最终会重新定义第一步中已分配的项目。

未测试：

Sub Get_Data_From_File()

    Dim FileToOpen As Variant, rngCopy As Range, rngPaste As Range
    Dim DAHelpPulse As Workbook, tbl As ListObject, issuekey, rw As Range
    
    FileToOpen = Application.GetOpenFilename(Title:="Browse & Import Jira Pulse Check", _
                 FileFilter:="Excel Files(*.xls*),*xls*")
    
    If FileToOpen <> False Then
        
        Application.ScreenUpdating = False
        
        Set DAHelpPulse = Application.Workbooks.Open(FileToOpen)
        With DAHelpPulse.Sheets(1)
            Set rngCopy = .Range(.Range("A2"), .Range("M2").End(xlDown))
        End With
            
        With ThisWorkbook.Worksheets("Import")
            .Visible = True
            Set rngPaste = .Range("A2").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count)
        End With
        rngPaste.Value = rngCopy.Value
        DAHelpPulse.Close False 'no save
        
        Set tbl = Sheet2.ListObjects("TicketReview")
        issuekey = Sheet2.Range("B2").Value
        
        For Each rw In rngPaste.Rows
            If rw.Cells(2) <> issuekey Then
                tbl.ListRows.Add.Range.Value = rw.Value
            End If
        Next rw
        
    End If
    
End Sub

运行-时间错误“1004”：范围 class 的 PasteSpecial 方法在尝试将具有匹配条件的行从一个 table 复制到另一个时失败

Run-time error '1004' : PasteSpecial method of Range class failed when attempting to copy a row with matching criteria from one table to another

excel

vba

runtime-error