Zelleintäge D1 bis DT 1 n-mal ab A4
01.06.2022 10:38:31
Manfred
ich konnte mit Eurer Hilfe mit VBA schon kleinere Probleme lösen, jetzt komme ich nicht weiter.
Ich habe schon im Archiv gesucht, versucht abzuleiten und kriege es einfach nicht hin.
Tabellenblatt "STEP 3 PreparationforUpload"
Ich habe in den Zellen D1 bis DT1 Werte stehen.
Diese sollen n-mal z.B. 94 mal (variabler Wert in Zelle C1) ab Zelle A4 untereinander kopiert werden.
Wenn der Wert aus Zelle D1 94 mal kopiert wurde (Eintrag Zelle A4 bis A97)
soll automatisch der Wert aus Zelle E1 94 mal kopiert werden (Eintrag Zelle A98 bis A191) und so weiter bis zur letzten Zelle DT1.
Wenn möglich soll automatisch erkannt werden wenn nach Zelle DT1 noch Einträge existieren....
Mein bescheidener VBA Code (funktioniert aber ;-) ) sieht so aus, jedoch wird dieser ellenlang werden und muss ggf. manuell angepasst werden
Sub ProduktEinfügen()
'Definition Variable
Dim rngSource As Excel.Range
Dim rngTarget As Excel.Range
Dim n As Long
Dim last As Integer
'kopiert Zelleintrag D1 94 mal untereinander
n = Range("C1").Value
Set rngSource = Range("D1")
Set rngTarget = Range("A4").Resize(rngSource.Rows.count * n)
Call rngSource.Copy(Destination:=rngTarget)
'springt zur nächsten freien Zelle in Spalte A
last = Cells(Rows.count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Range("E1")
'kopiert Zelleintrag ab E1 94 mal untereinander
n = Range("C1").Value
Set rngSource = Range("E1")
Set rngTarget = Cells(last, 1).Resize(rngSource.Rows.count * n)
Call rngSource.Copy(Destination:=rngTarget)
'springt zur nächsten freien Zelle in Spalte A
last = Cells(Rows.count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Range("F1")
'kopiert Zelleintrag ab F1 94 mal untereinander
n = Range("C1").Value
Set rngSource = Range("F1")
Set rngTarget = Cells(last, 1).Resize(rngSource.Rows.count * n)
Call rngSource.Copy(Destination:=rngTarget)
'springt zur nächsten freien Zelle in Spalte A
last = Cells(Rows.count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Range("G1")
'kopiert Zelleintrag ab G1 94 mal untereinander
n = Range("C1").Value
Set rngSource = Range("G1")
Set rngTarget = Cells(last, 1).Resize(rngSource.Rows.count * n)
Call rngSource.Copy(Destination:=rngTarget)
'springt zur nächsten freien Zelle in Spalte A
last = Cells(Rows.count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Range("H1")
'kopiert Zelleintrag ab H1 94 mal untereinander
n = Range("C1").Value
Set rngSource = Range("H1")
Set rngTarget = Cells(last, 1).Resize(rngSource.Rows.count * n)
Call rngSource.Copy(Destination:=rngTarget)
'springt zur nächsten freien Zelle in Spalte A
last = Cells(Rows.count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Range("I1")
'kopiert Zelleintrag ab I1 94 mal untereinander
n = Range("C1").Value
Set rngSource = Range("I1")
Set rngTarget = Cells(last, 1).Resize(rngSource.Rows.count * n)
Call rngSource.Copy(Destination:=rngTarget)
'springt zur nächsten freien Zelle in Spalte A
last = Cells(Rows.count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Range("J1")
End Sub
Viele Grüße
Manfred