Bom dia!!

Usando o gravador de macro você consegue obter esse resultado!

Att

como ficaria?

Bom dia!!

faça um filtro gravando a macro, caso não consegui tente.

Sub Tente()
    Dim bottomA As Integer
    bottomA = Sheets("Plan1").Range("A" & Rows.Count).End(xlUp).Row
    Dim c As Range
    For Each c In Sheets("Plan1").Range("B2:B" & bottomA)
        If c <> "" Then
            Cells(c.Row, 1).Copy Sheets("Plan2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next c
End Sub

Att