VBA копирует строки с перегибом, которые соответствуют критериям, на другой лист

Question

Я действительно не очень понимаю VBA, так что будьте терпеливы со мной.

У меня есть список людей, назначенных для определенного рейса (LEGID), и я хочу скопировать этих людей (пакет рабочей таблицы) в определенную ячейку в другой рабочей таблице (временная ячейка b15), но это не такработа.

Эта таблица данных представляет собой отчет о запросах от Salesforce.

Sub pax()

   Dim LastRow As Long
   Dim i As Long, j As Long
   Dim legid As String

Application.ScreenUpdating = False

legid = ThisWorkbook.Worksheets("setup").Range("SelReq").Value

Debug.Print legid


   'Find the last used row in a Column: column A in this example
   With Worksheets("pax")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

'   MsgBox (LastRow)
   'first row number where you need to paste values in temp'
   With Worksheets("temp")
      j = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
   End With

   For i = 1 To LastRow
       With Worksheets("pax")
           If .Cells(i, 1).Value = legid Then
               .Rows(i).Copy Destination:=Worksheets("temp").Range("a" & j)
               j = j + 1
           End If
       End With
   Next i

Application.ScreenUpdating = True

End Sub

Answer 1

Если вы хотите просто скопировать имена.Вы можете использовать это;однако вам нужно будет обновить имена и диапазоны ваших листов, если они названы диапазонами.Этот код просматривает определенную ячейку для значения на Листе3, затем, если это значение соответствует значению из диапазона на Листе1, он поместит значения из Столбца В на Листе1 в Лист2

Sub Test()
    Dim cell As Range
    Dim LastRow As Long, i As Long, j As Long
    Dim legid As String


    With Sheet1
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    With Sheet2
        j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With

    legid = Sheet3.Range("A1")

    For i = 2 To LastRow
        For Each cell In Sheet1.Range("A" & i)
            If cell.Value = legid Then
                Sheet2.Range("A" & j) = cell.Offset(0, 1).Value
                j = j + 1
            End If
        Next cell
    Next i

End Sub