Wert suchen und Zeile kopieren

https://www.herber.de/bbs/user/149538.xlsm
Hallo zusammen :-)
ich komme nicht weiter und habe auch keine Idee mehr. Kann mir jemand weiter helfen?
Ich habe Zeilen, die ich duplizieren muss, weil in einer Zelle 2 Werte stehen und diese müssen getrennt werden.
a) eine Zeile mit dem Wert 35 / 50
b) mache daraus 2 Zeilen einmal mit dem Wert 35 und einmal mit dem Wert 50
So habe ich 2 gleiche Zeilen, nur in jeder Zelle steht nur noch ein Wert drin.
Den Ablauf hätte ich mir so gedacht:
1- Suche die Artikelnummer in der Spalte D (die Artikelnummern stehen bereits im Code in der angehängten Mappe)
2- Kopiere die komplette Zeile mit dieser Artikelnummer und füge die am Ende der Tabelle an. Das so oft, bis alle Artikelnummern gesucht sind.
3. Sortiere die Spalte C und AS aufsteigend.
4. Suche wieder die erste Artikelnummer und springe in Spalte AS übernehme da den ersten Wert der Zelle
5. Mache das gleiche nochmal, nur springe mit Offset eine Zeile runter und übernehme den zweiten Wert in der Zelle.
6. Bis alle Nummern durch sind.
Mit dem Code in der Beispielmappe kann ich zumindest einmal die Zeile nach unten kopieren aber nicht für die restlichen Nummern und das Sortieren funktioniert auch nicht. Ist mir ein Rätzel.
Danke für die Hilfe, bzw. für die Tipps.
VG Eisi :-)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ZeileKopierenEinfügen() Dim lastRowAS As Long Dim i As Long Dim mySplit As Variant With tbl_H_Zubehoer_nachtraeglich lastRowAS = .Cells(.Rows.Count, 45).End(xlUp).Row For i = lastRowAS To 2 Step -1 mySplit = Split(.Range("AS" & i).Value, "/") If UBound(mySplit) > 0 Then .Rows(i).Copy .Rows(i + 1).Select Selection.Insert Shift:=xlDown Application.CutCopyMode = False .Range("AS" & i).Value = mySplit(0) .Range("AS" & i + 1).Value = mySplit(1) End If Next End With End Sub

Sub ZeileKopierenEinfügen() Dim lastRowAS As Long Dim i As Long Dim mySplit As Variant With tbl_H_Zubehoer_nachtraeglich lastRowAS = .Cells(.Rows.Count, 45).End(xlUp).Row For i = lastRowAS To 2 Step -1 mySplit = Split(.Range("AS" & i).Value, "/") If UBound(mySplit) > 0 Then .Rows(i).Copy .Rows(i + 1).Insert Shift:=xlDown .Range("AS" & i).Value = mySplit(0) .Range("AS" & i + 1).Value = mySplit(1) Application.CutCopyMode = False End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wert suchen und Zeile kopieren

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

307 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