Hallo zusammen,
ich habe in Spalte A Artikelnummern, jeweils dreimal untereinander. Jetzt sollen aus Zeile 2 die Zellen E2 bis G2 in Zeile 4 ab Spalte B und H2 bis J2 in Zeile 4 ab Spalte B und dann ab Zeile 5 die Zellen E2 bis G2 in Zeile 6 ab Spalte B und H2 bis J2 in Zeile 7 ab Spalte B usw. Das ist der Grundgedanke, der muss aber noch weiter geführt werden, da ich so mehrere Tabelln erstellen muss. Ich habe mal die Beispiel Tabelle beigefügt.
[
attachment=20255]
Hallo Bertha,
HÄ?
Glaubst du, dass diesen Satz jemand wirklich versteht?
Zitat: Jetzt sollen aus Zeile 2 die Zellen E2 bis G2 in Zeile 4 ab Spalte B und H2 bis J2 in Zeile 4 ab Spalte B und dann ab Zeile 5 die Zellen E2 bis G2 in Zeile 6 ab Spalte B und H2 bis J2 in Zeile 7 ab Spalte B
Zeige bitte in deiner Datei die Ausgangslage und wie das Ergebnis aussehen soll. Bei deiner Erklärung kriegt man ja einen Knoten im Hirn.
Hallo Berni,
sorry das habe ich mir leider fast schon gedacht. Ich habe jetzt in der zweiten Datei das Ergebnis dagestellt. So wird es hoffentlich Deutlicher.
[
attachment=20257]
Ok, jetzt ist alles klar. Nur noch eine Frage: Sind das immer genau 2 Leerzeilen, oder kann das abweichen?
Hallo,
das kann abweichen. es können auch mehrere Leerzeilen sein die Aufgefüllt werden müssen. Das sollen Stücklisten mit unterschiedlich vielen Bauteilen werden.
Wenn es dir bei mir nicht flott genug geht, dann wird dir bestimmt jemand anderes helfen wollen.
Danke für deine Nachricht, das fand ich sehr nett! Der Grund, wieso Crossposting eher unbeliebt ist, findet sich
hier, bitte lesen.
Zu deinem Problem:
Code:
Sub Zusammenfassen()
Dim lastZ As Long, lastS As Long, Spalte As Long
Dim ZZaehler As Integer, j As Integer, i As Long
Dim Bereich As Range
Set Bereich = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets("Tabelle1")
lastS = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
lastZ = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
Application.ScreenUpdating = False
For i = 2 To lastZ
If Cells(i, "B") <> "" Then
ZZaehler = Application.WorksheetFunction.CountIf(Bereich, Cells(i, "A"))
Spalte = 2
For j = 1 To ZZaehler - 1
Range(Cells(i, Spalte + 3), Cells(i, Spalte + 5)).Copy
Cells(i + j, 2).PasteSpecial Paste:=xlPasteValues
Spalte = Spalte + 3
Next j
End If
i = i + ZZaehler - 1
Next
Range(Cells(2, "E"), Cells(lastZ, lastS)).ClearContents
Application.ScreenUpdating = True
End Sub
Danke für deine Hilfe.
Ich habe den Code schon mal für die Musterdatei getestet uns es Klappt!!!
Werde es nachher mal an einer größeren Datei Testen und Berichten.
Crossposting habe ich jetzt verstanden. Kommt nicht mehr vor.
Habe es mit 160 Zeilen und jeweils 5 Leerzeilen getestet. Klappt.
Ein weiterer Test mit 10 Zeilen klappte wiederum nicht???
Ich habe mal die Datei die nicht geklappt hat beigefügt.
[
attachment=20267]