Per Macro Zelleninhalt kopieren und vervielfältige

Hallo an alle,
Ich brauche mal eine Tip, Gedankenanstoss o.ä.
Problem: Ich habe in Tabellenblatt in Spalte F ab Zeile 9 untereinander verscheide Kostenarten, insgesammt 21, soll aber variabel bleiben. In Spalte A ab Zeil 9 habe ich untereinander 50 Kostenstellen, soll auch variable bleiben.
Nun möchte ich den Kostenstellenblock (50St.) in ein anders Tabellenblatt kopieren,zb. ab B2, und zwar untereinander, so oft wie Kostenarten vorhanden sind. Danach müssen in eine Spalte daneben (C2) die Kostenarten kopiert werden, aber so, dass die erste Kostenart so oft untereinander seht wie die Kostenstellenanzahl, dann erst soll die nächste Kostenart kommen usw.
Das problem mit den Kostenstellen hab ich wohl gelöst, aber mit den Kostenarten klappt noch nicht.
Anzahl der Kostenstellen und Kostenarten wird durch mein Macro schon vorab ermittelt, dass klappt auch.
Hat jemand nee Idee?
Olli

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Olli,
hier ein Beispiel wie man es machen könnte. Tabellennamen und Workbook-Festlegungen ggf. anpassen.
Voraussetzung für die korrekte Bestimmung der Bereiche mit Kostenarten und Kostenstellen ist, dass in den Spalten A und F unterhalb der vorhandeneen Einträge keine weiteren Zellen ausgefüllt sind. D.h. in den Spalten A und F kann die Liste von KA und KST beliebig verlängert werden.
Gruß
Franz


Sub PlanErstellen()
Dim wbMuster As Workbook, wksMuster As Worksheet, wksNeu As Worksheet, ZeileNeu As Long
Dim rngKA As Range, rngKST As Range, I As Integer, J As Integer
Set wbNeu = ActiveWorkbook 'Arbeitsmappe mit der neuen Tabelle
Set wbMuster = ActiveWorkbook 'Arbeitsmappe mit der Musterliste
Set wksMuster = wbMuster.Worksheets("Tabelle1") 'Tabelle mit Kostenarten und Kostenstellen
Set wksNeu = ActiveSheet 'wbNeu.Worksheets("Tabelle2") 'Zieltabelle für neuen Plan
If wksNeu.Name = wksMuster.Name And wbNeu.Name = wbMuster.Name Then
MsgBox "Bitte vor dem Start des Makros neue Tabelle (Zieltabelle)wählen"
Exit Sub
End If
With wksMuster
Set rngKA = .Range(.Cells(9, 6), .Cells(.Rows.Count, 6).End(xlUp)) 'Bereich mit Kostenarten in Spalte F
Set rngKST = .Range(.Cells(9, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'Bereich mit Kostenstellen in Spalte A
End With
ZeileNeu = 2 '1. Zeile in Zieltabelle
For I = 1 To rngKST.Rows.Count
For J = 1 To rngKA.Rows.Count
wksNeu.Cells(ZeileNeu, 2).Value = rngKST(I, 1)
wksNeu.Cells(ZeileNeu, 3).Value = rngKA(J, 1)
ZeileNeu = ZeileNeu + 1
Next J
Next I
End Sub

Beliebteste Forumthreads (12 Monate)

Per Macro Zelleninhalt kopieren und vervielfältige

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Per Macro Zelleninhalt kopieren und vervielfältige

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread