12fach wiederholen

Hallo Excel-Leute,
in meine Datei habe ich in Spalte A Artikelnummern die in eine neue Datei mit eine Lagernummer 12fach wiederholt werden sollen, das sieht so aus:
Datei 1
in Zelle A1, A2, A3, A4 usw.
Überschrift
Artikelnummer1
Artikelnummer2
Artikelnummer3
Neue Datei produzieren:
in Zelle A1 (Überschrift), A2 bis A13 erste Artikelnummer1 12fach wiederholen, dann ab Zelle A14 bis A25 Artikelnummer2 (12fach wiederholen), in Zelle B1 Überschrift:Lagernummer, in Zelle B2 bis B13 00,01,10,20,30,40,50,60,66,80,88,90 in Zelle B14 bis B25 00,01,10,20,30,40,50,60,66,80,88,90
Überschrift
Zelle A2 Artikelnummer 1.Zelle B2 00
Zelle A3 Artikelnummer 1.Zelle B3 01
usw.
Hat jemand eine Idee wie ich das umsetzen kann?
Besten Dank vorab
VG Steve

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Make12() Dim wksOld As Worksheet Dim wksNew As Worksheet Dim iMulti As Integer Set wksOld = Sheets("Old") Set wksNew = Sheets("new") iMulti = 12 Dim iCol As Integer Dim lRow As Long Dim rArtikel As Range lRow = wksOld.Cells(wksOld.Rows.Count, 1).End(xlUp).Row wksNew.Cells.ClearContents With wksNew .Range("A1") = "Überschrift" For Each rArtikel In wksOld.Range("A2:A" & lRow) iCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 .Cells(1, iCol).Resize(1, iMulti).Value = rArtikel.Value .Cells(2, iCol + 0).Value = "00" .Cells(2, iCol + 1).Value = "01" .Cells(2, iCol + 2).Value = "10" .Cells(2, iCol + 3).Value = "20" .Cells(2, iCol + 4).Value = "30" .Cells(2, iCol + 5).Value = "40" .Cells(2, iCol + 6).Value = "50" .Cells(2, iCol + 7).Value = "60" .Cells(2, iCol + 8).Value = "66" .Cells(2, iCol + 9).Value = "80" .Cells(2, iCol + 10).Value = "88" .Cells(2, iCol + 11).Value = "90" '00,01,10,20,30,40,50,60,66,80,88,90 Next rArtikel End With End Sub

was muss ich im code ändern wenn es senkrecht aufgelistet werden soll?

alles :-)
Fängt mit der Kleinigkeit an, dass der Bezeichner iCol intuitiv als Spalte erkannt wird (vom User meine ich) und es ganz schlechter Stil wäre, daraus eine Zeile zu machen. Geht weiter mit der Variablendeklaration, die für Spalten interger ist - für Zeilen aber long sein sollte (nicht muss).
Während das nur Schönheitsfragen sind, muss natürlich auch jede Zellenzuordnung im Programm angefasst und geändert werden - da bisher die Zeilen ja FIX waren, jetzt aber die Spalten FIX sein sollen.
Sieht dann so aus:

Option Explicit
Sub Make12()
Dim wksOld As Worksheet
Dim wksNew As Worksheet
Dim iMulti As Integer
Set wksOld = Sheets("Old")
Set wksNew = Sheets("new")
iMulti = 12
Dim lRowNew As Long
Dim lRow As Long
Dim rArtikel As Range
lRow = wksOld.Cells(wksOld.Rows.Count, 1).End(xlUp).Row
wksNew.Cells.ClearContents
With wksNew
.Range("A1") = "Überschrift"
For Each rArtikel In wksOld.Range("A2:A" & lRow)
lRowNew = .Cells(.Rows.Count, 1).End(xlUp).eow + 1
.Cells(lRowNew, 1).Resize(iMulti, 1).Value = rArtikel.Value
.Cells(lRowNew + 0, 2).Value = "00"
.Cells(lRowNew + 1, 2).Value = "01"
.Cells(lRowNew + 2, 2).Value = "10"
.Cells(lRowNew + 3, 2).Value = "20"
.Cells(lRowNew + 4, 2).Value = "30"
.Cells(lRowNew + 5, 2).Value = "40"
.Cells(lRowNew + 6, 2).Value = "50"
.Cells(lRowNew + 7, 2).Value = "60"
.Cells(lRowNew + 8, 2).Value = "66"
.Cells(lRowNew + 9, 2).Value = "80"
.Cells(lRowNew + 10, 2).Value = "88"
.Cells(lRowNew + 11, 2).Value = "90"
'00,01,10,20,30,40,50,60,66,80,88,90
Next rArtikel
End With
End Sub

Achtung, Code ungetestet!
Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread