Извлечь строки из нескольких листов в один и исключить любую строку с # N / A

Question

У меня есть один лист данных, где мне нужно извлечь значения из нескольких столбцов и присвоить им значение.Столбец A - это строка, где столбцу B является присвоенное значение.Столбцы C и D являются поисковыми запросами, основанными на столбце A, и им также потребуется назначенное значение из столбца B.Пожалуйста, смотрите скриншоты.Мне нужно было бы составить список на отдельном листе.В идеале столбец A должен иметь данные из столбцов A, C и D с другого листа, а столбец B будет иметь назначенные значения.Единственное предостережение: мне нужно исключить любую строку с # N / A

. Любой макрос, который может работать, был бы очень полезен!

Код, который я использовал

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

Answer 1

Попробуйте:

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

Результаты: