PDA

Vollständige Version anzeigen : Datenbanken - Makro: Dynamisch Daten in Monatsspalten kopieren


MartinB90
01.09.2017, 09:47
Hallo,

ich habe eine Frage bzgl. einer VBA Datenbank. Ich würde gerne im Januar bestimmte Daten von Sheet "Input_01 | Hilf" zu Sheet "Datenbank" kopiere/einfügen. Das klappt soweit.

Mein Problem ist nun folgendes:

- Eine statische Spalte ("AN6:AN3000") aus dem "Input_01 | Hilf" Sheet soll monatlich automatisch in die ensprechende Monatspalte im "Datenbank" Sheet kopiert werden. Also im Januar von Sheet "Input_01 | Hilf" Spalte ("AN6:AN3000") in Spalte 'J'7 im Sheet "Datenbank" und so weiter.

Ich kann schon mit einer Hilfstabelle ("O13") die ensprechende Spaltennummer " Januar = 8" oder auch den Spaltennamen "Januar = J7" automatisch generieren ( Hier "i").

Jedoch schafft mein VBA Code nicht diese Information auszulesen und in die richtige Spalte einzufügen.


Dim i, j As Integer

Sub Martin_Input_Datenbank_kopieren()

Dim i As Integer

'Die Pivot-Tabelle wird aktualisiert.

ActiveSheet.PivotTables("PivotTableInput").PivotCache.Refresh

'Nun werden die statischen Definitionen der aktualisierten Liste kopiert und im Reiter "Datenbank" immer in die selbe Spalte eingefügt.

ActiveSheet.Range("AI6:AI3000").Copy
Sheets("Input_01 | Datenbank").Select
ActiveSheet.Range("AI6:AI3000").Copy

Sheets("Input_01 | Datenbank").Select
Range("B7").PasteSpecial xlPasteValues

'Nun sollen die statischen Definitionen der aktualisierten Liste in "Input_01 | Hilf" kopiert und im Reiter "Datenbank" monatlich in die entsprechende Spalte eingefügt werden. Bei benutzung des Makros in Januar in J7, im Februar in K7 usw.

i = ThisWorkbook.Sheets("Hilfstabellen").Range("O13").Value

Sheets("Input_01 | Hilf").Select
ActiveSheet.Range("AN6:AN3000").Copy
Sheets("Input_01 | Datenbank").Select
Range("i").PasteSpecial xlPasteValues

'Schließlich sollen die doppelten Werte entfernt werden, um die Eindeutigkeit der Daten zu gewährleisten.
Application.CutCopyMode = False
Sheets("Input_01 | Datenbank").Select
ActiveSheet.Range("B5:B6000").Select
Selection.RemoveDuplicates Columns:=1

End Sub


Vielen Dank :)