Übertragen von Werten mit der Funktion before Save

Ein schönnes Hallo ersteinmal,
ich habe folgendes Problem, ich habe 2 Excel tabellen.Die erste ist die Lieste "Vordrucke" und als Extra Datei die Liste "ToDo Liste".
Jetzt sollen in die Liste "Vordrucke" Werte eingetragen werden und diese Liste soll dann unter anderem Namen gespeichert werden.
Da mehrere Leute diese Vordrucke ausfüllen möchte ich erreichen das bestimmte Zellen, mit der Funktion beforeSave in die ToDo Liste kopiert werden.
Es sollen von der Liste Vordrucke die Zelle A1 nach Nach der ToDo Liste in Spalte A unter dem Letzden eintrag.A1 soll drei mal dort hin untereinander
A55/56/57 sollen in die Spalte C untereinander neben die Einträge von Spalte A.
C 55/56/57 soll dann in B der ToDo Liste
und B 10 soll dreimal in Spalte D der ToDo Liste
ich hoffe Ihr könnt mir da noch folgen.
Da ich davon ausgehe das die ToDo Liste geschlossen ist müßte ich die Liste vorher öffnen Lassen und dan die Werte kopieren lassen. Wenn ich das richtig verstehe, mein Versuch sieht folgender maßen aus:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i, LastRow
Workbooks.Open "G:\10.3\sachgebiet\10.32\10.322\Gemeinsam\Verwaltung Anlagen Kälteerzeugung\ _
Termine\ToDo Liste.xls"
LastRow = Sheets("todo liste").Cells(Rows.Count, 1).End(xlUp).Row + 1 
For i = 0 To 2
Sheets("todo liste").Range("A" & LastRow + i) = ThisWorkbook.ActiveSheet.Range("A1")
Sheets("todo liste").Range("B" & LastRow + i) = ThisWorkbook.ActiveSheet.Range("A" & 55 + i)
Sheets("todo liste").Range("C" & LastRow + i) = ThisWorkbook.ActiveSheet.Range("C" & 55 + i)
Sheets("todo liste").Range("D" & LastRow + i) = ThisWorkbook.ActiveSheet.Range("A10")
Next
ActiveWorkbook.Close True
End Sub

Wenn ich dann auf Speichern gehe führt das Makro aus und gibt mir über den Debbuger folgendes raus.
Laufzeitfehler `9`:
Index außerhalb des gültigem Bereichs
Der Teil des Makros welcher dick geschrieben ist, ist der Teil der mir makiert wird.
Ich hoffe mir kann jemand Helfen.
Mit freundlichen Grüßen
Sebastian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim i As Long, LastRow As Long, sNameToDo As String Dim wksToDo As Worksheet, wksEingabe As Worksheet, wbToDo As Workbook Set wksEingabe = ActiveSheet 'oder ThisWorkbook.Worksheets("TabelleXYZ") sNameToDo = "G:\10.3\sachgebiet\10.32\10.322\Gemeinsam\Verwaltung Anlagen Kälteerzeugung\" _ & "Termine\ToDo Liste.xls" Set wbToDo = Workbooks.Open(sNameToDo) Set wksToDo = wbToDo.Worksheets("todo liste") With wksToDo LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 For i = 0 To 2 .Cells(LastRow + i, 1) = wksEingabe.Range("A1") .Cells(LastRow + i, 2) = wksEingabe.Cells(55 + i, 1) .Cells(LastRow + i, 3) = wksEingabe.Cells(55 + i, 3) .Cells(LastRow + i, 4) = wksEingabe.Range("A10") Next End With wbToDo.Close True End Sub

For i = 0 To 2 .Cells(LastRow + i, 1) = wksEingabe.Range("A1") ' von A1 --> A .Cells(LastRow + i, 3) = wksEingabe.Cells(55 + i, 1) 'von Spalte A --> C .Cells(LastRow + i, 2) = wksEingabe.Cells(55 + i, 3) 'von Spalte C --> B .Cells(LastRow + i, 4) = wksEingabe.Range("A10") ' von A10 --> D Next

Beliebteste Forumthreads (12 Monate)

Übertragen von Werten mit der Funktion before Save

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread