enregistrer des modifications dans une liste de contacts à patir d'une autre feuille

Bonjour,

J'ai deux feuilles : "facture"(1) et "client"(2)

En 1 mes informations clients se trouvent sur la plage A3:F9
Les données de mes clients se trouvent sur la feuille 2

Dans une form j'ai crée une listbox qui me permet de chercher mes clients dans la feuille 2 et copier les informations sur la feuille 1
Le code de mon bouton de recherche client est le suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Option Explicit
Enum Table
 clients = 0
 facture = 1
End Enum
Dim sht(2) As Worksheet
 
Private Sub Cmdok_Click()
 
Frmrecherche.Hide
Worksheets("FACTURE").Activate
End Sub
 
Private Sub lstListContact_Click()
 With sht(Table.facture)
 Debug.Print Me.lstlistcontact.ListIndex + 1
 .Range("A4") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 1)
 .Range("D4") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 2)
 .Range("B5") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 3)
 .Range("D5") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 4)
 .Range("D1") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 5)
 .Range("D6") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 6)
 .Range("B7") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 7)
 .Range("D7") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 8)
 .Range("F7") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 9)
 .Range("D8") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 10)
 .Range("C9") = sht(Table.clients).Cells(Me.lstlistcontact.ListIndex + 2, 11)
 End With
End Sub
 
 
Private Sub userform_Initialize()
 Dim tblSrce As String ' Adresse de la Table Contact pour RowSource
 With ThisWorkbook
  Set sht(Table.clients) = .Worksheets("Clients")
  Set sht(Table.facture) = .Worksheets("FACTURE")
 End With
 With sht(Table.clients)
  tblSrce = .Name & "!" & Range(Cells(1000, 1), Cells(.Range("A1:A1000").End(xlDown).Row, .Range("A1:A1000").End(xlToRight).Column)).Address
 End With
 With Me.lstlistcontact
 .ColumnHeads = True
 .ColumnCount = 1
 .ColumnWidths = "60;60;80"
 .RowSource = tblSrce
 End With
 
End Sub

Une fois le client trouvé, ces informations étant inscrite sur la feuille 1, je finalise en appuyant sur un bouton
Les fonctions de ce bouton sont :
- enregistrer le bon dans un nouveau fichier excel (pas important)
- imprimer le bon (pas important)
- réinitialiser la feuille 1 comme elle était avant d'entrer les informations clients pour permettre une nouvelle recherche

Le code de ce bouton est :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub enregistre()
Dim Chemin As String, Fichier As String, Fact As String
Dim Wbk As Workbook
Dim Sh As Worksheet
Dim NumLigneVid As Integer
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
        IgnorePrintAreas:=False
 
Application.ScreenUpdating = False
Chemin = "C:\Users\xxxxxx\Desktop\Bon de commande\" 'Dossier de sauvegarde = celui du fichier FACTURE"
Fichier = Format(Date, "dd-mm-yyyy") & ".xls"    'nom du fichier archive
Fact = Worksheets("FACTURE").Range("C3").Value   'N° Facture
If Dir(Chemin & Fichier) = "" Then               'Si le classeur n'existe pas, on le crée et on nomme la première feuille avec le N° de facture
    Set Wbk = Workbooks.Add(1)
    Set Sh = Wbk.Worksheets(1)
    Sh.Name = Fact
    Wbk.SaveAs Chemin & Fichier
Else                                             'Si le classeur existe, on l'ouvre
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    If Not Existe(Wbk, Fact) Then                'Si la feuille N° Facture n'existe pas, on l'ajoute dans le classeur qu'on vient d'ouvrir
        Set Sh = Wbk.Worksheets.Add(after:=Wbk.Sheets(Wbk.Sheets.Count))
        Sh.Name = Fact
    Else
        Set Sh = Wbk.Worksheets(Fact)
    End If
End If
Dim lignevide As Integer
 
ThisWorkbook.Worksheets("FACTURE").Range("A1:F35").copy Sh.Range("A1")
Sh.UsedRange.Value = Sh.UsedRange.Value
Set Sh = Nothing
Wbk.Close True
Set Wbk = Nothing
Efface
 
End Sub
 
Private Function Existe(ByVal Wbk As Workbook, ByVal Str As String) As Boolean
Dim Sh As Worksheet
 
For Each Sh In Wbk.Sheets
    If UCase(Sh.Name) = UCase(Str) Then
        Existe = True
        Exit For
    End If
Next Sh
End Function
 
 
Sub Efface()
With ThisWorkbook.Worksheets("utilitaire")
    On Error Resume Next                           'au cas ou A11:A35 est vide
    ThisWorkbook.Worksheets("Facture").Range("A11:E32").SpecialCells(xlCellTypeConstants).copy .Cells(.Rows.Count, 3).End(xlUp)(2)
    On Error GoTo 0
With .Range("C2:G1200").Font
        .Name = "Calibri"
        .Size = "11"
        .Bold = True
    End With
    With .Range("C2:G1200")
        .UnMerge
        .Merge True
        .HorizontalAlignment = xlLeft
    End With
 
Dim NewLig As Long
 
Application.ScreenUpdating = False
 
With Worksheets("FACTURE")
 
    With .Range("A11:E32")
        .UnMerge
        .ClearContents
        .Merge True
        .HorizontalAlignment = xlLeft
    End With
    .Range("F11:F32") = ""
    Union(.Range("A4"), .Range("D4:D8"), .Range("B5"), .Range("B7"), .Range("C9"), .Range("F7"), .Range("F10"), .Range("D1"), .Range("M1")).Value = "/"
    With .Range("A11:F32").Font
        .Name = "Calibri"
        .Size = "11"
        .Bold = True
    End With
 
    .Range("C3").Value = Val(.Range("C3")) + 1
    .Range("E3").Value = Val(.Range("E3")) + 1
End With
 
With Worksheets("utilitaire")
.Range("I2:I36") = ""
End With
End With
ActiveWorkbook.Save
End Sub

Mon probleme se situe au niveau de la derniere étape au moment d'imprimer et d'enregistrer le bon.
Je souhaiterai pouvoir modifier les informations clients directement sur la plage A3:F9 et que les modifications s'appliquent dans la bonne case dans ma feuille 2

Par exemple le numéro de telephone s'affiche en D8 sur la feuille 1. Dans ma feuille 2 les numeros de telephone sont dans la colonne "J" et correspondent chacun à un nom

Lorrsque je recherche un nom grace à mon bouton "recherche client", les informations de la feuille 2 s'affichent en 1 et le numero de telephone du client se trouvera sur la case "D8"
Si le client a changé son numero de telephone je souhaiterai pouvoir le changer directement sur la feuille 1 sur "D8" et ,lorsque j'utilise le bouton d'enregistrement, que les informations modifiées remplacent les anciennes informations dans ma feuille 2

Je vous envoi le fichier en complément pour que vous puissiez me comprendre.
Il est en xlxs, pour activer les macros il suffit de le sauvegarder avec prise en charge macro.
, le module 3 c'est pour "encaissement livraison" et frmrecherche pour le bouton "recherche"

Cordialement