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

[miru_13]

Bonjour,
Je suis à la recherche d'une astuce.
Je suis en train de créer une fiche clientèle dans Excel, cette fiche contient des cellules avec des informations : Nom, Tél, Adresse, etc.
A la fin de la saisie du texte j'ai crée un bouton (dans Développeur - Insérer - Contrôles de formulaire) que j'ai appelé "Sauvegarde".
L'idée c'est que je voudrais, en appuyant sur le bouton "Sauvegarde" sauvegarder/retranscrire les informations dans une base de données Excel contenant les mêmes entêtes de colonnes que les cellules de ma fiche clientèle.
Comment pourrais-je exporter ces informations?

Ci-joint mon fichier Excel

Merci d'avance,
Miruna

 

[Papou-net]

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

Bonjour miru_13, et bienvenue à toi,

Voici le début de la marche à suivre dans le fichier ci-joint. J'ai commencé le remplissage des 4 premières colonnes, je te laisse le soin de continuer pour les suivantes.

Tu devras compléter, à la suite, les lignes de la macro Sub Save(), située dans Module1.

Tu ne précises pas si tu connais le langage macro, alors pour rappel :

Lancer l'éditeur VBA en tapant ALT + F11 (ou bien Onglet Développeur, bouton Visuial Basic)

Dans la fenêtre de gauche (Projet - VBA Project) tu cliques sur la croix de Modules

Double-clic sur Module1 affichera le code

Tu insères les lignes à compléter juste avant le End With (' lignes à ajouter)

Espérant t'avoir aidé.

Cordialement.

 

[miru_13]

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

Tout d'abord merci de ta réponse rapide.
Effectivement je ne connais pas le langage macro ainsi que VBA mais j'avais des doutes qu'il s'agissait de ça.
Ta réponse m'a été d'une grande aide car maintenant je sais ce que je dois réviser.

Si j'aurais d'autres questions je vais faire appel à ta gentillesse.

Excellent site!

Cordialement

 

[jp14]

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

Bonjour

Ci dessous une procédure qui copie les données en fonction du nom de la zone et des entêtes de colonnes, les données se trouvant dans la colonne adjacente. Il faut que les dénominations soient identiques.
Cette méthode permet de modifier le dessin de la feuille de saisie sans modifier le code.


Il faut modifier les optionboutons el les prendre dans les outils "Boite à outils Controles"

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

A tester

JP