VBA créer une boucle ???

Sub Boucle()


    Dim Limite As Long, Boucle As Long
    
    ' Trouve la fin de la boucle
    Limite = ActiveSheet.Range("B65535").End(xlUp).Row
    
    Range("B1").Select
    
    For Boucle = 0 To Limite
        ' Si la cellule Bi est non vide (où i est représenté ici par Boucle)
        If (ActiveCell.Offset(Boucle, 0).Value <> "") Then
            ' Alors dans la cellule de gauche (Ai) affecte la valeur courante de Bi
            ActiveCell.Offset(Boucle, -1).Value = _
                ActiveCell.Offset(Boucle, 0).Value
        End If
    Next Boucle
    

End Sub

Dim Derlig As Long, i As Long, j as Long      
Derlig = Range("B" & Rows.Count).End(xlUp).Row   
j=1
With  Sheets("feuil2")
For i= 1 To Derlig         
    If .Cells(i,2).Value <> " Then
         .Cells(j,1).Value= .Cells(i,2).Value
         j=j+1
    End If
Next i

Sub RegroupeEnA() 
Dim TablColB, TablColA(), i As Long, Lig As Long 

TablColB = Range("B1", Range("B" & Rows.Count).End(xlUp)) 
'ici commence le travail en mémoire... 
For i = LBound(TablColB) To UBound(TablColB) 
    If TablColB(i, 1) <> "" Then 
        ReDim Preserve TablColA(Lig) 
        TablColA(Lig) = TablColB(i, 1) 
        Lig = Lig + 1 
    End If 
Next 
'restitution
Range("A1").Resize(UBound(TablColA), 1) = Application.Transpose(TablColA) 
End Sub

Sub Appel_Fonction_RegroupeEnA()
Dim TablB, ColRestit As String
'ici tu remplis la variable tableau avec les données de la colonne B
TablB = Range("B1", Range("B" & Rows.Count).End(xlUp))
'tu choisis ta colonne de restitution
ColRestit = "A"
'et tu appelles ta fonction
RegroupeEnA TablB, ColRestit
End Sub

Function RegroupeEnA(TablColB, Col As String)
Dim TablColA(), i As Long, Lig As Long

'ici commence le travail en mémoire...
For i = LBound(TablColB) To UBound(TablColB)
    If TablColB(i, 1) <> "" Then
        ReDim Preserve TablColA(Lig)
        TablColA(Lig) = TablColB(i, 1)
        Lig = Lig + 1
    End If
Next
'restitution
Range(Col & "1").Resize(UBound(TablColA), 1) = Application.Transpose(TablColA)
End Function

Function RegroupeEnA(Plage As Range, Ligne As Long)
Dim Tabl(), i As Long, Lig As Long
Dim PremLig As Long, DrLig As Long, Col As String

Col = Split(Plage.Address, "$")(1)
PremLig = Left(Split(Plage.Address, "$")(2), 1)
DrLig = Split(Plage.Address, "$")(4)
ReDim Tabl(DrLig - 1)
Lig = 0
For i = PremLig To DrLig
    If Range(Col & i).Value <> "" Then
        Tabl(Lig) = Range(Col & i).Value
        Lig = Lig + 1
    End If
Next
For i = LBound(Tabl) To UBound(Tabl)
    Debug.Print Tabl(i)
Next
RegroupeEnA = Tabl(Ligne)
End Function