Ошибка выполнения "1004": метод PasteSpecial класса Range завершился неудачно при попытке скопировать строку с критериями соответствия из одной таблицы в другую.

Question

У меня есть рабочая книга, в которой хранится довольно много данных. Я пытаюсь импортировать еженедельный отчет, вставить его в таблицу, l oop через импортированную информацию, и если строка не соответствует ключу проблемы во второй таблице, строку необходимо скопировать и вставить во вторую таблицу .

Все работает, пока не дойдет до части кода Вставить. Кажется, что выделение не копируется? Я пробовал несколько методов устранения неполадок, но ни один из них не помог.

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