VBA - Bereiche Kopieren
29.06.2020 01:44:48
Julian
ich hab mir zur Aufgabe gemacht mittels VBA Daten aus Spaltenbereichen eines Arbeitsblattes ("Kontoblatt" Spalten A, B und E) in ein anderes Arbeitsblatt (Database Zahlungsverkehr F, C und J) der selben Mappe zu Kopieren. Dies soll nach Möglichkeit mittels Button-Click erfolgen. Der Button soll auf dem Ziel-Arbeitsblatt vorhanden sein.
Spalte A zu F ist ein Datum
Spalten B zu C und E zu J sind reine Zahlen
Beide Arbeitsblätter bestehen noch aus weiteren Spalten mit Daten die aber nicht kopiert werden sollen.
Das Arbeitsblatt ("Kontoblatt") aus welchem die Daten Kopiert werden sollen beginnt in Spalte A, das Arbeitsblatt ("Database Zahlungsverkehr") in welches diese eingefügt werden soll mit Spalte B.
Das Arbeitsblatt aus welchem die Daten kopiert werden wird nach dem Kopieren geleert (hier würde ein manuelles löschen genügen) und dann jeweils wieder mit Daten gefüllt werden, aus einem anderen Programm (manuell). Bzw. würde ich unten stehenden Code so ergänzen:
Set wsCopy = Workbooks("Mappe1.xlsx").Worksheets("Kontoblatt")
Set wsDest = Workbooks("Mappe2.xlsm").Worksheets("Database Zahlungsverkehr")
Momentan erhalte ich eine "eine(?! eventuell auch mehr)" Fehlermeldungen.
Laufzeitfehler 1004: Die Methode 'Range' für das Objekt' _Worksheet' Ist fehlgeschlagen
Da ich absoluter Anfänger bin und den Fehler leider nicht selber beheben kann habe ich gehofft das Ihr mir helfen könnt. Wahrscheinlich ist der Code auch absoluter murks, da ich mir diesen mittels Google Suche und Youtube selber zusammengebastelt habe.
Private Sub CommandButton1_Click()
Dim wsCopy As Worksheet, wsDest As Worksheet
Dim lDestLastRow As Long, Index As Long
Dim SourceArr As Variant, DestArr As Variant
Dim Source As Range, Dest As Range
Set wsCopy = ThisWorkbook.Worksheets("Kontoblatt")
Set wsDest = ThisWorkbook.Worksheets("Database Zahlungsverkehr")
With wsDest
lDestLastRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
End With
SourceArr = Array("A", "B", "E")
DestArr = Array("F", "C", "J")
For Index = LBound(SourceArr) To UBound(SourceArr)
Set Source = wsCopy.Range(SourceArr(Index))
Set Dest = wsDest.Range(DestArr(Index) & lDestLastRow)
Source.Copy
Dest.PasteSpecial (xlPasteValues)
Next Index
End Sub
Danke Euch bereits jetzt
Julian