XL 2019 Cellules fusionnées

[risch_cyril]

Bonsoir,

j'ai un probleme dans mon code on me dit qu'il ne marche pas sur une cellule fusionnée pourriez vous remedier à cela en changeant la ligne de code concerné s'il vous plait ?

Sub Calcul()
Dim chemin$, fichier$, a(), n&
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "gestion*.xlsx")
ReDim a(1 To Rows.Count, 1 To 2)
While fichier <> ""
    n = n + 1
    a(n, 1) = fichier
    a(n, 2) = "=SUM('" & chemin & "[" & fichier & "]" & "Janvier:Décembre'!C168)" 'formule de liaison
    fichier = Dir
Wend
'---restitution---
With Feuil1 'CodeName à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[C3] '1ère cellule de destination, à adapter
        If n Then .Resize(n, 2) = a
        .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
        If n Then
            .Offset(n + 1) = "Total"
            .Offset(n + 1, 1) = "=SUM(R[" & -n - 1 & "]C:R[-2]C)"
        End If
    End With
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

 

[risch_cyril]

C'est cette ligne là qui bloque tout

.Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 2).ClearContents

 

[Phil69970]

Bonjour @risch_cyril , le forum

Une piste...

.Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 2).MergeArea.ClearContents

Et plus général :

Dim CellClear As Range
With Sheets("Ma feuille") '<== A adapter
    For Each CellClear In .Range("Ma plage à nettoyer") '<== A adapter
        If CellClear.MergeCells = True Then
              CellClear.MergeArea.ClearContents
        Else
              CellClear.ClearContents
        End If
    Next
End With

@Phil69970

 

[job75]

Bonsoir,

Oui ClearContents peut poser problème avec les cellules fusionnées.

Dans ce cas il suffit de ne pas l'utiliser :

.Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 2) = ""

A+