Zellverbund aufheben, Wert in alle Zellen einfügen

Sub Verbundene_trennenA()   ' (Vertikal verbundene Zellen in Spalte A)
Dim rngM As Range, rngC As Range, zz As Long
For zz = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(zz, 1).MergeCells Then
Set rngM = Cells(zz, 1).MergeArea
rngM.MergeCells = False
For Each rngC In rngM
If rngC.Address  rngM.Cells(1).Address Then rngC = rngM.Cells(1)
Next rngC
zz = rngM.Row
End If
Next zz
End Sub

Sub InAllenBlaettern()

Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets

Select Case wks.Name

Case "xyz", "Summe" ' Blätter, die NICHT bearbeitet werden sollen

Case Else

wks.Select

Verbundene_trennenA

End Select

Next wks

End Sub