verbundene Zellen trennen mit gleichm inhalt

[Statistik]

Hallo zusammen,

ich würde gern verbundene Zellen trennen und als Ergebnis mehrere Zellen mit dem Selben Inhalt haben Anstat den Inhalt in einer Zelle und die anderen sind leer.

Es sind ca. 2000 Verbundene Zellen die jeweils untereinander stehen.

[
Bild bitte so als Datei hochladen: Klick mich!
]

Ist das prinzipiell möglich?



Beste Grüße und Dank im Voraus!

[WillWissen]

Hi,

wenn du verbundene Zellen auflöst, bleibt ein Wert stehen, den du dann runterkopieren kannst.

[marose67]

Hallo,
verbundene Zellen aufheben - Text in Spalten.

Gruß
Marcus

[Statistik]

Hi,

wenn du verbundene Zellen auflöst, bleibt ein Wert stehen, den du dann runterkopieren kannst.

Genau das manuelle runterkopieren möchte ich verhindern. Gibt es da eine automatische Funktion? Sonst sitze ich da ewig dran (da die verbunden Zeilen unterschiedliche Größe haben).

---

Hallo,
verbundene Zellen aufheben - Text in Spalten.

Gruß
Marcus

leider ist es Text in Zeilen.

[UweD]

Hallo

so evtl.??

Code:

Sub Makro1()
    Dim LR As Long, i As Long, Anz As Integer, RNG As Range
   
    LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
   
    For i = 1 To LR
        With Cells(i, 1)
            If .MergeCells Then
                Set RNG = Cells(i, 1).MergeArea
                Anz = .MergeArea.Rows.Count
                .MergeCells = False
                RNG = .Value
                i = i + Anz - 1
            End If
        End With
    Next
End Sub

LG UweD

[marose67]

Ich sehe hier kein Problem. Die verbundenen Zellen aufheben und in der rechten unteren Ecke ein Doppelklick. Dann wird überall der richtige Wert eingesetzt. Das passiert, wenn man mit verbundenen Zellen arbeitet ... Nacharbeit.

Ansonsten bleibt wohl nur ein Makro. Hier einmal mit dem Recorder aufgenommen. Umsetzen kann ich das nicht für eine komplette Tabelle. Lohnt sich für mich aber auch nicht, denn die Programmierung würde länger dauern als das Makro zu programmieren.

Sub Makro1()
'
' Makro1 Makro
'

'
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    ActiveWindow.SmallScroll Down:=6
    Range("A19").Select
    Selection.AutoFill Destination:=Range("A19:A38"), Type:=xlFillDefault
    Range("A19:A38").Select
    ActiveWindow.SmallScroll Down:=-27
End Sub


Gruß
Marcus