Eine Reihe von Zahlen x Mal einfügen
26.04.2018 10:40:01
Zahlen
Ich habe folgende Herausforderung. Ich arbeite an einer möglichst automatischen Upload-Datei, die bislang mit wenige Eingriffe funktionierte, jedoch möchte ich eine manuelle Intervention meinerseits abschaffen.
Inhalt der Tabelle:
- Periode (B10)
- Kostenstelle (C10)
- Konto (D10)
- Betrag (E10)
Herausforderung:
Jedes Konto muss im Upload-File enthalten sein und das 12 mal (da 12 Monate). Das bedeutet, wenn ich 300 Konten habe, dann muss in der Spalte B (Periode) 300 mal die 1 (für Januar) und dann 300 mal die 2 (für Februar) bis 12 (Dezember) aufgelistet werden. Zudem muss dann in der Spalte D (Konto) alle 300 Konten aufgeführt werden.
Ziel: Die Menge aller Zellen, die einen Wert enthalten, sollen, ab der Zelle B11 mit der Zahl 1 eingefügt werden und danach fortlaufend mit +1 addiert werden, bis die Zahl 12 erreicht wird. Und ab Spalte D11 alle 300 Konten 12 mal.
Mein Versuch mit dem VBA-Recorder:
Sub Makro5()
' Makro5 Makro
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[10]),1,""Fehler"")"
Range("B11").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=102
Range("B11:B125").Select
ActiveSheet.Paste
Range("L11").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-102
Range("D11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B11").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=24
Range("B126").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B126").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-115]C+1"
Range("B126").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("D125").Select
Range(Selection, Selection.End(xlUp)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=105
Range("D126").Select
ActiveSheet.Paste
End Sub
Vielen Dank im Voraus.
Shiro