XL 2016 Fusionner les doublons de date

[scrib]

Bonjour,
Je voudrais fusionner les cases qui ont la même date, mais le code que j'ai fais ne fonctionne pas, pouvez-vous m'aider?
L'erreur que je reçois est :
Ligne => "Un.Add.Cell , CDate(Cell)"
instruction => "CDate(Cell)"
Erreur retournée => erreur compilation: argument non facultatif

Dim Plage As Range
    Dim Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim Nombre As Integer
     Set Plage = Sheets("feuil2").Crange("A2:A1048521")
    On Error Resume Next
    For Each Cell In Plage
        Un.Add.Cell , CDate(Cell)
        If Err.Number <> 0 Then
            Nombre = Nombre + 1
            ReDim Preserve Tableau(1 To Nombre)
            Tableau(Nombre) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0
    If Nombre = 0 Then
        Exit Sub
    End If
    For nomnbre = UBound(Tableau) To LBound(Tableau) Step -1
        Sheets("Feuil2").Cells(Tableau(Nombre)).Merge
    Next Nombre

Merci pour vos futures réponses

 

[Excel_addin]

Bonjour scrib, le forum
Peux-tu nous fournir un fichier exemple stp ?
En attendant,
il y a quelques fautes de frappe dans ton code :

Ligne 6 (remplace Crange par range)

Set Plage = Sheets("feuil2").Crange("A2:A1048521")

Ligne 9 (remplace Un.Add.Cell par Un.Add Cell

Un.Add.Cell , CDate(Cell)

Ligne 21 (remplace nomnbre par nombre)

For nomnbre = UBound(Tableau) To LBound(Tableau) Step -1

Cordialement.

 

[pierrejean]

Bonjour scrib

Je te suggère cette macro

Sub fusion()
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
   If IsDate(Range("A" & n)) And Range("A" & n - 1) = Range("A" & n) Then
    Application.DisplayAlerts = False
      Range("A" & n & ":A" & n - 1).MergeCells = True
    Application.DisplayAlerts = True
   End If
Next
End Sub

 

[scrib]

Bonjour pierrejean et Excel_addin,
Merci pour vos réponses, je mets le fichier est en pièce jointe. J’essaierai vos solutions demain matin et je reviens vers vous.
Cordialement.

 

[scrib]

Bonjour scrib

Je te suggère cette macro

Sub fusion()
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
   If IsDate(Range("A" & n)) And Range("A" & n - 1) = Range("A" & n) Then
    Application.DisplayAlerts = False
      Range("A" & n & ":A" & n - 1).MergeCells = True
    Application.DisplayAlerts = True
   End If
Next
End Sub

Merci pour cette solution.

 

[scrib]

Bonjour pierrejean,

La solution fonctionne, mais si l'on ouvre plusieurs fois sur le fichier ça ne fonctionne pas.
Ca ne reprend pas les cases fusionnées de la session d'avant. Je joints le fichier pour essai.
Merci
Cdtl.

 

[scrib]

Je viens de trouver la réponse à ma dernière question.
Merci à vous deux.