Bonsoir le forum

J'ai un code qui normalement devrait me permettre de copier des données d'un classeur et les coller sur un autre suivant certaines conditions.
Lorsque j'exécute la macro, les éléments à copier sont effacés et le collage ne se réalise pas non plus.
Ci-dessous le besoin initiale:
Je viens solliciter votre aide pour un travail important.
En effet, j’ai deux (2) fichiers.
A partir du fichier de départ« ETAT_RECAP_1 » je dois copier les données et les coller sur le fichier « Fiche_Base ».
Seuls les éléments de la colonne c du fichier «ETAT_RECAP_1» ayant leur correspondance dans la colonne c du fichier de destination (Fiche_Base) devront être collés sinon pas de collage.
Les données du fichier de départ (C:I) doivent être collées respectivement (et sur la ligne correspondante) en C, D, E, H, J, L et N.
Suivant l’esprit de notre besoin, si tout se passe bien, les éléments colorés en jaune du fichier "ETAT_RECAP_1" devront être copiés et collés sur le fichier « FICHE_BASE »
Ci-dessous le code réalisé pour appréciation car ne donne pas satisfaction:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub rapproche()
Dim c, Cel
Dim Source As Workbook
Dim Cible As Workbook
Dim Client
  Chemin = ActiveWorkbook.Path
  'ChDir Chemin
  'Nomfich = Application.GetOpenFilename("documents excel(*.xlsx),*.xlsx", , , , True)
  On Error Resume Next
  Set Ws1 = Worksheets("ETAT")
  Set Ws2 = Workbooks("fiche_base.xlsx")
  Ws1.Select
  Set Cible = ActiveWorkbook
  Set Client = Ws1.Range("C5:C" & [C80000].End(xlUp).Row)
  For Each Cel In Client
    'Client = Cel.Value
    With Ws2.Sheets("feuil1").Range("c:c")
      Set c = .Find(What:=Cel, LookIn:=xlValues, LookAt:=xlWhole)
      If Not c Is Nothing Then
        FirstAddress = c.Address
        Do
          Cel.Offset(0, 1).Value = c.Offset(0, 1) ' nom
          Cel.Offset(0, 2).Value = c.Offset(0, 2) ' tel
          Cel.Offset(0, 3).Value = c.Offset(0, 5) ' date naiss
          Cel.Offset(0, 4).Value = c.Offset(0, 7) ' civilité
          Cel.Offset(0, 5).Value = c.Offset(0, 9) '  sit matr
          Cel.Offset(0, 6).Value = c.Offset(0, 11) ' profession
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
       End If
      End With
    Next Cel
  End Sub