Fusion de cellules

Bonjour,

Je suis très débutant en VBA. J'essaie de créer une macro pour fusionner des cellules lorsqu'une condition est remplie, mais ça ne fonctionne pas.

Ma colonne A contient des dates.

Lorsqu'il y a 2 dates identiques consécutives, j'aimerais que les cellules correspondantes des cellules C et D soient fusionnées.

Je vous envoie un fichier excel contenant un exemple de ce que j'aimerais faire.

La feuille résultat est un exemple de ce que j'aimerais obtenir à partir des données de la Feuil1.

J'ai essayé le code suivant, mais ça ne fonctionne pas lorsque je le lance en me positionnant sur la cellule A1.

Sub Fusion ()
Dim date1 as integer
Dim date2 as integer
ActiveCell.value = date1
ActiveCell.offset(1,0).value = date2
If date1 = date2 Then
ActiveCell.offset(0,2).Range("A1:A2").Select
Selection.Merge
ActiveCell.offset(0,1).Select
Selection.Merge
End sub

Merci beaucoup pour votre aide

Bonsoir,

Teste ce qui suit :

Sub Fusion()

    Dim I As Integer

    'de la seconde cellule à la dernière
    For I = 2 To 11

        'compare la cellule en cours avec celle d'avant
        If Cells(I, 1).Value = Cells(I - 1, 1).Value Then

            'fusionne
            Range(Cells(I, 1), Cells(I - 1, 1)).Offset(, 2).Merge
            Range(Cells(I, 1), Cells(I - 1, 1)).Offset(, 3).Merge
            Range(Cells(I, 1), Cells(I - 1, 1)).Offset(, 2).VerticalAlignment = xlCenter

        End If

    Next I

End Sub

Theze a écrit :

Bonsoir,

Teste ce qui suit :

Sub Fusion()

    Dim I As Integer

    'de la seconde cellule à la dernière
    For I = 2 To 11

        'compare la cellule en cours avec celle d'avant
        If Cells(I, 1).Value = Cells(I - 1, 1).Value Then

            'fusionne
            Range(Cells(I, 1), Cells(I - 1, 1)).Offset(, 2).Merge
            Range(Cells(I, 1), Cells(I - 1, 1)).Offset(, 3).Merge
            Range(Cells(I, 1), Cells(I - 1, 1)).Offset(, 2).VerticalAlignment = xlCenter

        End If

    Next I

End Sub

Ça fonctionne à merveille!

Merci beaucoup!