Makro zur Übernahme mehrerer Datenzeilen in 1 Zell

Hallo zusammen,
ich habe aktuell ein Problem mit einer mir zur Verfügung gestellten Excel-Tabelle.
In einer Spalte sind Daten zu einem Datensatz über mehrere Zeilen verteilt, d.h. ich habe z.B. die Spalte A = "Artikelbeschreibung" und hier ist die komplette Beschreibung zum Artikel über mehrere Zeilen A1, A2, A3, A4 usw. verteilt. Irgendwann kommt dann ein neuer Artikel, ist erkennbar an Spalte B mit der Artikelnummer:
Userbild

Da ich die Excel für die Weiterbearbeitung in ein ERP System formatieren muss und hierzu die Artikelbeschreibung in 1 Zelle enthalten sein muss, suche ich nun nach einem Makro, mit dem ich mehrere Zellen markieren kann und mir dann vom Makro der Inhalt aller markierten Zellen in 1 Zelle übernommen wird.
Ich hoffe mir kann hierzu hier im Forum jemand weiterhelfen. Von Makros habe ich leider nicht so viel Ahnung.
Vielen Dank im Voraus.
Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Übernahme_Dateizeilen() Dim x As Long Dim y As Long y = 1 With Sheets("Tabelle1") For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(x, 1).Value "" And _ .Cells(x, 2).Value "" Then y = y + 1 .Cells(y, 3).Value = .Cells(x, 1).Value End If Next x End With End Sub

Moin Ludwig,
ich habe deinen Wunsch einmal wörtlich genommen

Option Explicit
Sub EineZeile()
Dim rng As Range, c As Range, AnzZe As Long, xConcat As String
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set rng = Selection
AnzZe = rng.Rows.Count
For Each c In rng
xConcat = xConcat & c & Chr(10)
Next c
xConcat = Left(xConcat, Len(xConcat) - 1)
rng.Rows("2:" & AnzZe).EntireRow.Delete
rng.Rows(1) = xConcat
ErrorHandler:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic '(oder was eingestellt war)
.Calculate
End With
End Sub

Und ja, es geht natürlich auch automatisch, aber wer weiß, warum du den Wunsch so geäußert hast? Also erst einmal eine Kopie des Arbeitsblattes erstellen, dann die zusammenzufassenden Zeilen markieren und das Makro aufrufen. Natürlich kannst du auch einen Button anlegen und die Sub darüber aufrufen, das geht vielleicht besser.

Sub ohne_markierung() Dim A As Range For Each A In Columns(2).SpecialCells(4).Offset(-1, -1).Areas A.Cells(1, 1) = Join(Application.Transpose(A), " ") A.Offset(1).EntireRow.Clear Next Columns(1).SpecialCells(4).EntireRow.Delete Columns(1).AutoFit End Sub

Beliebteste Forumthreads (12 Monate)

Makro zur Übernahme mehrerer Datenzeilen in 1 Zell

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro zur Übernahme mehrerer Datenzeilen in 1 Zell

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread