Verbundene Zellen wieder auflösen

Verbundene Zellen wieder auflösen via 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
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt