Datensatz kopieren+einfügen - Code verinfachen
23.09.2019 12:23:57
Christian
Für ein Projekt habe ich den unten stehenden Code geschrieben. Mit diesem sollen Daten(Aktienkursdaten) von Tabellenblatt "Eingabe" in Tabellenblatt "Daten" verschoben werden und anschließend die Spalte A5 und B5 bis Ende geleert werden. Des Weiteren sollen ein paar Spezifische Kenndaten, wie Name ISIN und Variablentyp in das Tabellenblatt "Daten" kopiert werden.
Die Daten aus Tabellenblatt "Eingabe" sollen die bereits verschobenen Daten im Tabellenblatt "Daten" nicht überschreiben, sondern in einer Spalte direkt daneben eingefügt werden.
Bisher sind es meistens ca. 250 Kursdaten sowie Datumsangaben welche kopiert werden sollen. Jedoch kann die Anzahl auch auf mehere tausend ansteigen.
Da mein bisheriger Code sehr langsam ist, würde ich gern einen Vorschlag für eine schnellere Variante bekommen.
(der letzte Wert des Datensatz soll nicht mitkopiert werden, da dieser meist fehlerbehaftet ist.)
Vielen Dank
Christian
Sub DatenkopierenEinfügen()
'Variablen definieren
Dim i As Long
Dim n As Long
Dim letzteZeile As Integer
Dim letzteSpalte As Integer
Dim Eingabe As Worksheet
Dim Daten As Worksheet
Set Eingabe = ThisWorkbook.Worksheets("Eingabe")
Set Daten = ThisWorkbook.Worksheets("Daten")
'ermittelt die letzte Zeile. Zählt von der letzten Reihe rückwärts bis zur ersten beschriebenen _
Zeile.
letzteZeile = Eingabe.Cells(Rows.Count, 2).End(xlUp).Row
'ermitteln welches die erste leere Spalte ist.
letzteSpalte = Daten.Cells(2, Columns.Count).End(xlToLeft).Column
n = letzteSpalte + 1
'Zeilen und Spalten in Tabellenblatt Daten fixieren.
Daten.Activate
Range("B5").Activate
ActiveWindow.FreezePanes = True
Eingabe.Activate
'Kopiert die Überschriften und Indexspezifischen Daten
Eingabe.Cells(1, 2).Cut Destination:=Daten.Cells(1, n)
Eingabe.Cells(2, 2).Cut Destination:=Daten.Cells(2, n)
Eingabe.Cells(3, 2).Cut Destination:=Daten.Cells(3, n)
'Kopiert Daten aus Spalte A und B in neues Tabellenblatt
For i = 5 To letzteZeile - 1
Eingabe.Cells(i, 1).Copy Destination:=Daten.Cells(i, 1)
Eingabe.Cells(i, 2).Cut Destination:=Daten.Cells(i, n)
Daten.Cells(4, 2).Copy Destination:=Daten.Cells(4, n)
Next i
Eingabe.Range("B1").SpecialCells(xlCellTypeLastCell).Clear
End Sub