Pour le classement de Photos.

Sub travdem()
Dim Cellule1 As Range, Cellule2 As Range
Dim Nomfeuille1 As String, Col1 As String
Dim Nomfeuille2 As String, Col2 As String
Dim MonTab As Variant, Compt1 As Long
Dim PasTrouve As Boolean
'parametre
Nomfeuille1 = "Feuil1"
Col1 = "A"

Col2 = "d"

For Each Cellule1 In Sheets(Nomfeuille1).Range(Col1 & "20:" & Col1 & Sheets(Nomfeuille1).Range(Col1 & Sheets(Nomfeuille1).Rows.Count).End(xlUp).Row)
On Error GoTo erreur1
PasTrouve = False
Sheets(CStr(Cellule1)).Select

If PasTrouve = False Then
    Nomfeuille2 = Cellule1
    For Each Cellule2 In Sheets(Nomfeuille2).Range(Col2 & "3:" & Col2 & Sheets(Nomfeuille2).Range(Col2 & Sheets(Nomfeuille2).Rows.Count).End(xlUp).Row)
        If IsDate(Cellule2) Then
            Cellule1.Offset(0, Month(Cellule2)) = Cellule1.Offset(0, Month(Cellule2)) + Cellule2.Offset(0, 1)
       End If
    Next Cellule2
End If
Next Cellule1
On Error GoTo 0
Exit Sub
erreur1:
PasTrouve = True
Resume Next
End Sub