Verbundene Zellen wieder auflösen

MergeCells


Spalte A enthält teilweise mehrere verbundene Zellen (Beispiel unten). Diese
sollen wieder aufgelöst werden, da sonst keine Einzelauswertungen mit Hilfe
des Autofilters möglich wären...

Sub verbundene_zellen()
Dim verbZelle As Variant
Dim zelle As Range
Dim bereich%
Dim eintrag_alt$
Dim eintrag_neu$

bereich = Worksheets(1).UsedRange.Rows.Count
verbZelle = Worksheets(1).Range("A2:A" & bereich).MergeCells

If IsNull(verbZelle) Then
eintrag_alt = Worksheets(1).Range("A2").Value 'Startpunkt Zelle A2
For Each zelle In Worksheets(1).Range("A2:A" & bereich)
If zelle.MergeCells Then
zelle.UnMerge
eintrag_neu = zelle.Value
eintrag_alt = eintrag_neu
Else
If IsEmpty(zelle.Value) Then zelle.Value = eintrag_alt
End If
Next zelle
End If
End Sub

Beispiel vorher:			nachher:
A	B	C	A	B	C
Name	verkauft	Typ	Name	verkauft	Typ
schulz	11	neu	schulz	11	neu
bauer	22	alt	bauer	22	alt
müller	33	neu	müller	33	neu
weber	44	alt	weber	44	alt
krause	55	neu	krause	55	neu
	66	alt	krause	66	alt
	77	neu	krause	77	neu
	88	alt	krause	88	alt
amman	99	neu	amman	99	neu
	110	alt	amman	110	alt
	121	neu	amman	121	neu
	132	alt	amman	132	alt
krause	143	neu	krause	143	neu
	154	alt	krause	154	alt
	165	neu	krause	165	neu
	176	alt	krause	176	alt
	187	neu	krause	187	neu
amman	198	alt	amman	198	alt
	209	neu	amman	209	neu
	220	alt	amman	220	alt
	231	neu	amman	231	neu
	242	alt	amman	242	alt
krause	253	neu	krause	253	neu
amman	11	alt	amman	11	alt
krause	55	neu	krause	55	neu
	66	alt	krause	66	alt
	77	neu	krause	77	neu
	88	alt	krause	88	alt