Boucle colonne

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim BE As Variant 'déclare la variable BE (Boîte d'Entrée)
Dim R As Range 'déclare la variable R (Recherche)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim CD As Integer 'déclare la variable CD (Colonne de Destination)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD (à adapter à ton cas)
deb: 'étiquette
BE = Application.InputBox("Taper le titre de la colonne à rechercher.", "TITRE", Type:=2) 'définit la boîte d'entrée BE
If BE = "" Or BE = False Then Exit Sub 'si non renseignée ou bouton"[Annuler], sort de la procédure
Set R = OS.Rows(1).Find(BE, , xlValues, xlWhole) 'définit la recherche R (recherche le mot entier de la boîte d'entrée dans la ligne 1 de l'onglet source)
If R Is Nothing Then 'condition : si aucune occurrence trouvée
    MsgBox "Titre non trouvé !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
COL = R.Column 'définit la colonne COL
'définit la colonne de destination CD (colonne de la première cellule vide de l'onglet destination)
CD = IIf(OD.Cells(1, 1) = "", 1, OD.Cells(1, Application.Columns.Count).End(xlToLeft).Column + 1)
OS.Columns(COL).Copy OD.Cells(1, CD) 'copie la colonne COL et la colle dans la colonne CD
If MsgBox("Nouveau titre à chercher ?", vbYesNo) = vbYes Then GoTo deb 'si "Oui"au message retourne à l'étiquette "deb"
End Sub