Clever-Excel-Forum

Normale Version: Zeilen kopieren mit verschieden Endungen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2
KLAPPT JETZT !! DANK!!
So?

Arbeitsblatt mit dem Namen 'Tabelle1'
EFG
2Art.-Nr NEU
3a-sKLEID110
4a-mKLEID110
5a-lKLEID110
6b-sKLEID210
7b-mKLEID210
8b-lKLEID210
9c-sKLEID310
10c-mKLEID310
11c-lKLEID310
12d-sKLEID410
13d-mKLEID410
14d-lKLEID410
15e-sKLEID510
16e-mKLEID510
17e-lKLEID510
18

ZelleFormel
F3=WENNFEHLER(INDEX($B$3:$B$7;ZEILE()/3);"")
G3=WENNFEHLER(INDEX($C$3:$C$7;ZEILE()/3);"")
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016
Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg
..ich bins nochmal!!

..wie kann ich Deinen Quellcode so erweitern,  dass noch die Grössen XL und XXL dazugefügt werden?

Danke Dir
So...

Code:
Sub Umschreiben()
Dim i As Long, last As Long

last = Cells(Rows.Count, 1).End(xlUp).Row

For i = last To 2 Step -1
  Rows(i + 1 & ":" & i + 4).Insert shift:=xlDown
  Rows(i).Copy
  Rows(i + 1 & ":" & i + 4).PasteSpecial Paste:=xlAll
  Cells(i, 1) = Cells(i, 1) & "-s"
  Cells(i + 1, 1) = Cells(i + 1, 1) & "-m"
  Cells(i + 2, 1) = Cells(i + 2, 1) & "-l"
  Cells(i + 3, 1) = Cells(i + 3, 1) & "-xl"
  Cells(i + 4, 1) = Cells(i + 4, 1) & "-xxl"
Next

End Sub

Für eventuelle weitere Größen vergleiche die beiden Codes Zeile für Zeile miteinander, dann schaffst du es auch, diese hinzuzufügen.
Seiten: 1 2