Plus le temps de mettre en place le code que déjà Michel est là. Pour une fois que j'avais la réponse. Pas mieux (même chose).
Bon week end à toutes & à tous
@ ++ Eric C
petite note sur la macro que j'utilise pour la mise a j
Sub Maj()
Range("B11:G35").Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell
Dim Cpt As Byte
Dim NbrLigSrc As Byte
Dim LigDepSrc As Byte
Dim NbrLigDst As Byte
Dim LigDepDst As Byte
Dim Trouve As Boolean
Dim ShSrc As Worksheet
Dim ShDst As Worksheet
Dim Recherche
Dim Premier As String
Set ShSrc = Sheets("Feuil1")
Set ShDst = Sheets("CLASSEUR")
LigDepSrc = 11
NbrLigSrc = ShSrc.Range("B36").End(xlUp).Row
If NbrLigSrc >= 11 Then
LigDepDst = 5
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row
For Cpt = LigDepSrc To NbrLigSrc
Trouve = False
With ShDst.Range("B" & LigDepDst & ":B" & NbrLigDst)
Set Recherche = .Find(What:=ShSrc.Range("B" & Cpt))
If Not Recherche Is Nothing Then
Premier = Recherche.Address
Do
If ShDst.Range("C" & Recherche.Row) = ShSrc.Range("C" & Cpt) Then
If ShDst.Range("D" & Recherche.Row) = ShSrc.Range("D" & Cpt) Then
ShDst.Range("A" & Recherche.Row) = Date
ShDst.Range("G" & Recherche.Row) = ShDst.Range("G" & Recherche.Row) + ShSrc.Range("G" & Cpt)
ShDst.Range("H" & Recherche.Row) = ShDst.Range("H" & Recherche.Row) + 1
Trouve = True
Exit Do
End If
End If
Set Recherche = .FindNext(Recherche)
Loop While Not Recherche Is Nothing And Recherche.Address <> Premier
End If
If Trouve = False Then
ShDst.Range("A" & NbrLigDst + 1) = Date
ShDst.Range("B" & NbrLigDst + 1) = ShSrc.Range("B" & Cpt)
ShDst.Range("C" & NbrLigDst + 1) = ShSrc.Range("C" & Cpt)
ShDst.Range("D" & NbrLigDst + 1) = ShSrc.Range("D" & Cpt)
ShDst.Range("G" & NbrLigDst + 1) = ShSrc.Range("G" & Cpt)
ShDst.Range("H" & NbrLigDst + 1) = 1
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row
End If
End With
Next
End If
End Sub