Zeilen zusammenfügen mit bestimmten Parametern

Guten Tag,
Meine Kenntnisse in VBA sind leider sehr begrenzt.
Ich habe mich versucht an einem Makro welches Zeilen Verbinden kann ohne , dass die Inhalte gelöscht werden. An sich funktioniert es.:

Sub zusammen()
Dim rng As Range
Dim a As String
For Each rng In Selection
a = a & vbLf & rng.Value
rng.ClearContents
Next
Cells(Selection.Row, Selection.Column) = a
End Sub

Ich markiere meine Zellen die verbunden werden sollen und das funktioniert erstmal.
Im Anhang(https://www.herber.de/bbs/user/93280.xlsm) habe ich ein Beispiel wie Listen aussehen die ich bearbeite.
Ziel von mir ist es mit einem Makro jeweils aus Spalte D , E und F Zellen bis zur nächsten laufenden Nummer in Spalte A zu verbinden.
Sobald also in Spalte A die nächste laufende nummer kommt müssten von da an die nächsten Information in Spalte D,E und F verbunden werden und das wieder bis zur nächsten laufenden nummer, solang bis es keine laufenden Nummern mehr gibt.
über Unterstützung würde ich mich sehr freuen.
Mfg David

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
kannst mal so testen.
Ist ohne Überprüfung ob Daten im Bereich vorhanden sind!

Option Explicit

Sub Zusammen()
Dim rng As Range, rngTmp As Range
Dim MaxRow&, n&, nn&, MaxCol&
Dim strValue$

With Tabelle1
    MaxRow = .Cells(.Rows.Count, 4).End(xlUp).Row
    MaxRow = Application.Max(MaxRow, .Cells(.Rows.Count, 5).End(xlUp).Row)
    MaxRow = Application.Max(MaxRow, .Cells(.Rows.Count, 6).End(xlUp).Row)
    MaxCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    Set rng = .Range("A7", .Cells(MaxRow, MaxCol))
    
    For n = 1 To rng.Rows.Count
        If rng.Cells(n, 1) <> "" And rngTmp Is Nothing Then
            If rngTmp Is Nothing Then
                Set rngTmp = rng.Rows(n)
            End If
        Else
            If rng.Cells(n, 1) = "" And Not rngTmp Is Nothing Then
                Set rngTmp = Union(rngTmp, rng.Rows(n))
            End If
            If (rng.Cells(n, 1) <> "" Or n = rng.Rows.Count) And Not rngTmp Is Nothing Then
                If rngTmp.Rows.Count > 1 Then
                    For nn = 4 To MaxCol
                        strValue = Join(Application.Transpose(rngTmp.Columns(nn)), Chr(10))
                        FormatBereich rngTmp.Columns(nn)
                        rngTmp.Columns(nn).Cells(1, 1).Value = strValue
                    Next nn
                End If
                n = n - 1
                Set rngTmp = Nothing
                strValue = ""
            End If
        End If
    Next n
End With
End Sub

Sub FormatBereich(rngRange As Range)
With rngRange
    .ClearContents
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .MergeCells = True
End With
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Zeilen zusammenfügen mit bestimmten Parametern

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread