Option Explicit
 
Sub Tst1()
Dim LastRowA As Long
Dim i As Long, j As Long
    LastRowA = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    j = 1
 
    Application.ScreenUpdating = False
    Feuil1.Columns("B:B" ).ClearContents
    For i = 1 To LastRowA
        If Feuil1.Cells(i, 1) <> "" Then
            Feuil1.Cells(j, 2) = Feuil1.Cells(i, 1)
            j = j + 1
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Sub Tst2()
Dim LastRowA As Long, cA As Range
Dim i As Long
    LastRowA = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    i = 1
 
    Application.ScreenUpdating = False
    Feuil1.Columns("B:B" ).ClearContents
    For Each cA In Feuil1.Range("A1:A" & LastRowA)
        If cA.Value <> "" Then
            Feuil1.Cells(i, 2) = cA.Value
            i = i + 1
        End If
    Next cA
    Application.ScreenUpdating = True
End Sub
 
Sub Tst3()
Dim LastRowA As Long
    Application.ScreenUpdating = False
    Feuil1.Columns("B:B" ).ClearContents
    LastRowA = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    With Feuil1
        .Range("A1:A" & LastRowA).AutoFilter Field:=1, Criteria1:="<>"
        .Range("A1:A" & LastRowA).Copy .Range("B1" )
        .Range("A1:A" & LastRowA).AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub