Sub MiseAJourMémo()
Dim Cel As Range, DLig As Long, Lig As Long
Dim Mémo As String
Dim ShtD As Worksheet
' Définir la feuille de destination des mémos
Set ShtD = Sheets("Mémos")
' Avec la feuille qui contient les mémos
With Sheets("2012")
' Pour chaque mémo contenu dans les cellules
For Each Cel In .Cells.SpecialCells(xlCellTypeComments)
' Récupérer la dernière ligne remplie de la feuille Mémos
DLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row
ShtD.Range("A" & DLig + 1) = Cel.Address
ShtD.Range("B" & DLig + 1) = Cel.Comment.Text
' Effacer le commentaire de la cellule
Cel.Comment.Delete
Next Cel
End With
' Faire l'inverse
Set ShtD = Sheets("2012")
' Avec la feuille dans laquelle on a enregistré les mémos
With Sheets("Mémos")
' Récupérer le numéro de la dernière ligne remplie
DLig = .Range("A" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = 2 To DLig
' Récupérer le mémo
Mémo = .Range("B" & Lig)
' N'iscrire que les commentaires contenant une info
If Mémo <> "" Then
ShtD.Range(.Range("A" & Lig)).AddComment Text:=Mémo
End If
Next Lig
End With
End Sub