Exporter les informations d'une fiche contact(Excel) dans un tableau Excel

Option Explicit

Private Sub CommandButton1_Click()
Dim Dl2 As Long, dl1 As Long
Dim Cellule As Range
Dim Nomfeuille1 As String
Dim Col As String
'parametre
Nomfeuille1 = "Feuil1"
Col = "A"

With Sheets("Fichier général")
    Dl2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    If Dl2 < 3 Then Dl2 = 3

For Each Cellule In Sheets(ActiveSheet.Name).Range(Col & "2:" & Col & Sheets(ActiveSheet.Name).Range(Col & Sheets(ActiveSheet.Name).Rows.Count).End(xlUp).Row)
    Select Case Trim(Cellule.Value)
        Case ""
        Case "Civilité*"
            dl1 = RechercheColonne(Cellule.Value)
            If dl1 > 0 Then
                If OptionButton1.Value = True Then .Cells(Dl2, RechercheColonne(Cellule.Value)) = "Mr"
                If OptionButton2.Value = True Then .Cells(Dl2, RechercheColonne(Cellule.Value)) = "Mme"
            End If
        Case "* champs obligatoires"
        Case "Commentaires" 'à terminer
        Case "Adresse" ' à terminer
        Case Is <> ""
        dl1 = RechercheColonne(Cellule.Value)
            If dl1 > 0 Then .Cells(Dl2, dl1) = Cellule.Offset(0, 1)
        
    End Select
Next Cellule
Col = "d"
For Each Cellule In Sheets(ActiveSheet.Name).Range(Col & "2:" & Col & Sheets(ActiveSheet.Name).Range(Col & Sheets(ActiveSheet.Name).Rows.Count).End(xlUp).Row)
    Select Case Trim(Cellule.Value)
        Case ""
        Case "Civilité*"
            dl1 = RechercheColonne(Cellule.Value)
            If dl1 > 0 Then
                If OptionButton1.Value = True Then .Cells(Dl2, RechercheColonne(Cellule.Value)) = "Mr"
                If OptionButton2.Value = True Then .Cells(Dl2, RechercheColonne(Cellule.Value)) = "Mme"
            End If
        Case "* champs obligatoires"
        Case "Commentaires"
        Case "Adresse"
        Case Is <> ""
            dl1 = RechercheColonne(Cellule.Value)
            If dl1 > 0 Then .Cells(Dl2, dl1) = Cellule.Offset(0, 1)
        
    End Select
Next Cellule




End With




End Sub
Private Function RechercheColonne(Texte As String) As Long
Dim Cel2 As Range
Dim plg As Range
Dim data1 As String
data1 = Trim(Replace(Texte, "*", ""))
data1 = Trim(Replace(data1, ":", ""))
With Sheets("Fichier général")
Set plg = .Range(.Cells(1, 1), .Cells(1, 3))
For Each Cel2 In plg
    If data1 = Trim(Cel2) Then
        RechercheColonne = Cel2.Column
        Exit Function
    End If
Next Cel2
Set plg = .Range(.Cells(2, 3), .Cells(2, .Cells(2, Rows(2).Cells.Count).End(xlToLeft).Column))
For Each Cel2 In plg
    If data1 = Trim(Cel2) Then
        RechercheColonne = Cel2.Column
        Exit Function
    End If
Next Cel2
End With
End Function