运行时错误'1004'：尝试将具有匹配条件的行从一个表复制到另一个表时，PasteRange 类的特殊方法失败

Question

我有一个工作簿，里面存储了很多数据。我正在尝试导入周报，将其粘贴到表中，循环浏览导入的信息，如果某行与第二个表中的问题关键字不匹配，则需要将该行复制并粘贴到第二个表格中。

在到达代码的粘贴部分之前，一切都正常。所选内容似乎没有被复制？我尝试了几种故障排除方法，但都不起作用。

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