macro comparaison et copie ne fonctionne pas

[superbog]

bonjour,

J'avais interrogé le forum pour une macro mais, sans réponse, j'ai tenté un bidouillage maison... malheureusement il apparaît clairement que mes compétences sont dépassées alors si quelqu'un pouvait corriger mon code ce serait super sympa

voici l'idée: une feuille récapitulative (audiences) et une feuille par dossier. j'ai un macro (fonctionnelle) pour copie chaque ligne de la feuille récapitulative dans le dossier correspondant. Mais (et c'est tout le problème) il arrive que la date change alors que la ligne a déjà été copiée. Pour simplifier, je note la nouvelle date sur la ligne de la feuille récapitulative quand c'est le cas.

Il faut donc une macro qui parcours la feuille récap et qui, lorsqu'elle la colonne "H" n'est pas vide compare alors les données de la feuille dossier (col J à M) à celle de la feuille récapitulative audiences (col C à G) et lorsqu'elle que ces données sont identiques, alors la cellule D de la feuille récapitulative remplace les cellules K et P de la feuille dossier

je joins le fichier test

Sub test2()

Dim i, t, DerLigBase, DerLig, lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA, rCelB As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean

'Recherche de la dernière ligne
DerLigBase = Sheets("audiences").Range("B300").End(xlUp).Row
Set colFeuille = New Collection

On Error Resume Next
    
    'Boucle sur la plage de cellule
    For Each rCelA In Sheets("audiences").Range("C2:C" & DerLigBase)
    colFeuille.Add rCelA, CStr(rCelA)
    Next rCelA

    'Recherche de la ligne et tri dans chaque feuille
    For i = 2 To DerLigBase
    dossier = Cells(i, 2).Text
    lig = Sheets(dossier).Range("J100").End(xlUp).Row
 
     'Boucle sur la plage de cellule
    For Each rCelB In Sheets(dossier).Range("J22:J100" & DerLigBase)
    colFeuille.Add rCelB, CStr(rCelB)
    Next rCelB



     'Copie les valeurs si non cochées
    With Sheets("audiences")
        For t = 22 To lig
    If (.Cells(i, 8)) <> "" And IsNumeric(Sheets("audiences").Cells(i, 2)) And Sheets("audiences").Range("C" & i & ":G" & i) = Sheets(dossier).Range("J" & t & ":M" & t) Then
    Sheets(dossier).Range("K", t) = Sheets("audiences").Range("D", i)
    Sheets(dossier).Range("P", t) = Sheets("audiences").Range("D", i)
    'colonne A vide
    Err = 0 'pour savoir si une erreur se produit
        
    If Err = 0 Then .Cells(i, 1) = "R"
  
       Next t
  End If

End With

 
Next i
MsgBox "terminé"

End Sub

Merci à ceux qui vont prendre un peu de temps pour me sortir de là.