Form an array based on criteria and paste to new worksheet

Hi,

Have you tried Data Advanced Filter ...?

something quick

you should be able to modify it to suit your needs

Sub arrayb()

    Dim DataArray() As String
    Dim LastRow As Integer
    Dim LastCol As Integer
    Dim i As Integer
    Dim j As Integer
    Dim DataRow As Integer
    
    LastRow = Cells.SpecialCells(xlLastCell).Row
    LastCol = Cells.SpecialCells(xlLastCell).Column
    
    ReDim DataArray(LastRow, LastCol)
    
    
    For i = 1 To LastRow
        If Worksheets("Sheet1").Cells(i, 5) = "B" Then
            For j = 1 To 5
                DataArray(i, j) = Worksheets("Sheet1").Cells(i, j)
            Next j
        End If
    Next i
    
    
    DataRow = 1
    
    For i = 1 To LastRow
        If DataArray(i, 1) <> "" Then
            For j = 1 To 5
                Worksheets("Sheet2").Cells(DataRow, j) = DataArray(i, j)
            Next j
            DataRow = DataRow + 1
        End If
    Next i
End Sub