Transfert de colonne vba excel

Option Explicit
Sub ajoutvirgule()

Dim i As Long
Dim j() As String
Dim nbvirgule As Integer
Dim cellule As Range
Dim plage As Range

Dim nomfeuille1 As String
Dim col1 As String
Dim classeur1 As String
Dim lidep1 As Long
Dim dl1 As Long

'**********************************
nomfeuille1 = "Sheet3"
col1 = "a"
lidep1 = 1

With Sheets(nomfeuille1)
dl1 = Sheets(nomfeuille1).Range(col1 & "65536").End(xlUp).Row
Set plage = .Range(col1 & lidep1 & ":" & col1 & .Range(col1 & "65536").End(xlUp).Row)
For Each cellule In plage
        j = Split(cellule.Value, ",")
        If UBound(j) > nbvirgule Then nbvirgule = UBound(j)
     
Next cellule
For Each cellule In plage
        j = Split(cellule.Value, ",")
        If UBound(j) < nbvirgule Then cellule.Value = "  ," & cellule.Value
     
Next cellule
End With

End Sub

Sub code_postal()
For i = 2 To Range("A65536").End(xlUp).Row
    'on récupere toutes l adresse sans blanc en trop (le trim)
    add_all = Trim(Cells(i, 1))
    'on compte le nombre de caractere de l adresse
    nb_car = Len(add_all)
    'on récupere l'adresse sans le code et la region
    add_final = Left(add_all, nb_car - 11)
    'on récupere le code et la region
    add_partie = Right(add_all, 11)
    'on récupere le region
    add_reg = Mid(add_partie, 1, 2)
    'on récupere la code
    add_code = Right(add_partie, 7)
'on remet dans les cases
Cells(i, 1) = add_final
Cells(i, 2) = add_code
Cells(i, 3) = add_reg
Next i
End Sub

Sub macroextraitCP()
For i = 2 To [A65536].End(xlUp).Row
Cells(i, 2) = _
StrReverse(Split(StrReverse(Cells(i, 1).Text), ".")(0))
Cells(i, 3) = _
StrReverse(Split(Split(StrReverse(Cells(i, 1).Text), ".")(1), " ")(0))
Next
End Sub

Sub macroALLinONE()
For i = 2 To [A65536].End(xlUp).Row
Cells(i, 2) = _
Split(StrReverse(Cells(i, 1).Text), ".")(0)
Cells(i, 3) = _
StrReverse(Split(Split(StrReverse(Cells(i, 1).Text), ".")(1), " ")(0))
Cells(i, 4) = _
StrReverse(Split(Split(StrReverse(Cells(i, 1).Text), ",")(1), " ")(0))
Next
End Sub

Sub macroALLinONE()
For i = 2 To [A65536].End(xlUp).Row
Cells(i, 2) = _
StrReverse(Split(StrReverse(Cells(i, 1).Text), ".")(0))
Cells(i, 3) = _
StrReverse(Split(Split(StrReverse(Cells(i, 1).Text), ".")(1), " ")(0))
Cells(i, 4) = _
StrReverse(Split(Split(StrReverse(Cells(i, 1).Text), ",")(1), " ")(0))
Next
End Sub