Bestimmter Teil einer Spalte in neue Spalte setzten

[Bertha]

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.



  Spalten.xlsx (Größe: 8,96 KB / Downloads: 9)

[MisterBurns]

Hallo Bertha,

HÄ?
Glaubst du, dass diesen Satz jemand wirklich versteht?

 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.

[Bertha]

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.


  Spalten1.xlsx (Größe: 8,99 KB / Downloads: 11)

[MisterBurns]

Ok, jetzt ist alles klar. Nur noch eine Frage: Sind das immer genau 2 Leerzeilen, oder kann das abweichen?

[Bertha]

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.

[steve1da]

Hola,

wenn aus der Bertha der Thorsten wird...

http://www.herber.de/forum/messages/1651505.html

Gruß,
steve1da

[MisterBurns]

Wenn es dir bei mir nicht flott genug geht, dann wird dir bestimmt jemand anderes helfen wollen.

[MisterBurns]

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

[Bertha]

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.

[Bertha]

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.




  Arme.xlsx (Größe: 9,99 KB / Downloads: 4)