Excel 将多张图纸中的行提取到一张图纸中，并排除带有#N/A的任何行

我有一张数据表，需要从多个列中提取值并为它们赋值。列A是一个字符串，其中列B是赋值。列C和D是基于列A的vlookups，它们也需要从列B分配的值。请看截图。我需要在另一张纸上编制一份清单。理想情况下，A列具有来自另一张表A、C和D列的数据，B列具有指定值。唯一需要注意的是，我需要排除任何不适用的行

任何可能工作的宏都将非常有用

我使用的代码

Sub Life_Saver_Button()
Dim lastrow As Long, erow As Long

Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")

lastrow = ThisWorkbook.Sheets("S1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
S1.Cells(i, 1).Copy
erow = ThisWorkbook.Sheets("S2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 1)

ThisWorkbook.Sheets("S1").Cells(i, 2).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 2)

ThisWorkbook.Sheets("S1").Cells(i, 3).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 1)

ThisWorkbook.Sheets("S1").Cells(i, 4).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 2)

ThisWorkbook.Sheets("S1").Cells(i, 5).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 1)

ThisWorkbook.Sheets("S1").Cells(i, 5).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 2)

Next i

Application.CutCopyMode = False
ThisWorkbook.Sheets("S2").Columns().AutoFit
Range("A1").Select

End Sub

尝试：

结果：

---

欢迎来到堆栈溢出。请注意，因为这不是免费的代码编写服务，所以有必要显示您迄今为止所做的尝试以及您遇到的问题或错误（通过显示代码），或者至少显示您所做的研究和努力。否则它只是要求我们为你做所有的工作。阅读可能有助于改进您的问题。我不断发现错误显示为“运行时错误13–类型不匹配”。行代码=.Range（“B”）和cell.Row.value出现错误。请告诉我.Range（“B”和cell.Row.value）的值好吗？

Option Explicit

Sub test1()

    Dim LastrowA As Long, Lastrow As Long, cell As Range, Code As Long
    Dim Desc As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Each cell In .Range("A1:D" & LastrowA)

            If Not IsError(cell.Value) = True And Not IsNumeric(cell.Value) = True Then

                Desc = cell.Value
                Code = .Range("B" & cell.Row).Value

                Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

                If LastrowA = Lastrow Then
                    .Range("A" & Lastrow + 2).Value = Desc
                    .Range("B" & Lastrow + 2).Value = Code
                Else
                    .Range("A" & Lastrow + 1).Value = Desc
                    .Range("B" & Lastrow + 1).Value = Code
                End If

            End If

        Next

    End With

End Sub