Hallo zusammen,
ich habe eine Datei mit dem Namen "EMailVersand.xlsm" mit einem Arbeitsblatt "versendete Mails" .
Die Tabelle enthält 7 Spalten.
In der 3. Zeile stehen die Überschriften sodass die eingetragenen Daten ab Zeile 4 beginnen.
Da sich durch die Menge an Einträgen die Laufzeit des Programms zunehmend verlängert gibt es eine
zweite Datei mit dem Namen "EMailArchiv.xlsm" mit dem gleichen Aufbau.
Ich möchte nun erreichen, dass wenn ich in der Datei "EMailVersand.xlsm" in Zelle A1 ein bestimmtes Datum
eingebe, alle Einträge die älter sind als das in A1 angegebene Datum in die Datei "EMailArchiv.xlsm" auf dem Arbeitsblatt "Archiv" unter
die bereits vorhandenen Einträge angefügt werden.
Die Daten sollen also aus der Datei "EMailVersand.xlsm" entfernt und in die Datei "EMailArchiv.xlsm" eingefügt werden.
Kann mir jemand von euch vielleicht weiterhelfen?
Gruß Frank
Hallo
nachdem keiner an den Thread rangegangen ist habe ich mir die Sache mal angeschaut. Bitte mal das Beispiel testen.
Du musst aber vorher im Makro im Modul1 noch deinen Ordnerpfad per Hand eintragen. Da steht noch mein Testpfad drin!
Wenn du in die Zelle A1 das Datum noch mal neu eingibst wird das Archiv still geöffnet, kopiert, geschlossen, und die Beispieldaten müssten im Archiv erscheinen. Ich denke noch einfacher kann die Lösung nicht sein. Würde mich freuen wenn alles einwandfrei klappt.
mfg Gast 123
Hallo, erst einmal Danke für deine Hilfe,
leider klappt es jedoch nicht.
Sub Daten_archivieren()
Dim AC As Range, Datum As Date, lz1 As Long
Dim Archiv As Worksheet, j As Long, lzA As Long
Set Archiv = Workbooks("EMailArchiv.xlsm").Worksheets("versendete Mails")
With ThisWorkbook.Worksheets("versendete Mails")
On Error GoTo Fehler
'** Hier bitte Ihren Ordnerpfad angeben!!
Workbooks.Open Filename:="H:\DE\Bremen\Garden\Front Office\Module\Backup\EMailArchiv.xlsm"
Windows("EMailVersand.xlsm").Activate
Datum = CDate(.Range("A1")) 'Datum laden
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
lzA = Archiv.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Schleife zum Daten ins Archiv kopieren
For Each AC In .Range("A3:A" & lz1)
If CDate(AC.Cells(1, 1)) < Datum Then
AC.Resize(1, 7).Copy Archiv.Cells(lzA, 1)
AC.Resize(1, 7).ClearContents
Application.CutCopyMode = False
lzA = lzA + 1
End If
Next AC
'Schleife zum alte Daten rückwärts löschen
Application.EnableEvents = False
For j = lz1 To 3 Step -1
If .Cells(j, 1) = Empty Then .Rows(j).Delete shift:=xlUp
Next j
Application.EnableEvents = True
Workbooks("EMailArchiv.xlsm").Save
Workbooks("EMailArchiv.xlsm").Close
End With
Exit Sub
Fehler: Application.EnableEvents = True
MsgBox "Fehler beim Archivieren aufgetreten" & vbLf & "Stimmt der Ordnerpfad?"
End Sub
An dieser Stelle tritt ein Fehler auf "außerhalb des gültigen Bereichs"
Set Archiv = Workbooks("EMailArchiv.xlsm").Worksheets("versendete Mails")
Gruß Frank
Hallo Frank
du hast recht, kleiner dummer Programmierfehler! Die Set Anweisung gehört HINTER Workbook.Open, die Datei muss dafür geöffnet sein!
Denke bitte daran bei Workbook.Open deinen Ordnerpfad anzugeben! Da steht noch mein Testordner drin!
mfg Gast 123
Code:
With ThisWorkbook.Worksheets("versendete Mails")
On Error GoTo Fehler
Application.ScreenUpdating = False
'** Hier bitte Ihren Ordnerpfad angeben!!
Workbooks.Open Filename:="D:\Excel Forum\EMailArchiv.xlsm"
Set Archiv = Workbooks("EMailArchiv.xlsm").Worksheets("versendete Mails")
usw.
Hallo, Vielen Dank,
es klappt schon besser, aber dennoch tritt ein Fehler auf
'Schleife zum Daten ins Archiv kopieren
For Each AC In .Range("A3:A" & lz1)
If CDate(AC.Cells(1, 1)) < Datum Then
AC.Resize(1, 7).Copy Archiv.Cells(lzA, 1)
AC.Resize(1, 7).ClearContents
Application.CutCopyMode = False
lzA = lzA + 1
End If
Next AC
Fehlermeldung: Typen unverträglich
Hallo Frank
dann bitte hier noch mal schauen. Fängt bei dir das 1. Datum in Zeile 3 oder in Zeile 4 an? Ggf. den Range Bereich auf 4 korrigieren.
For Each AC In .Range("A4:A" & lz1)
mfg Gast 123
Das erste Datum steht in Zeile 4
Ja, jetzt klappt es !!!
Vielen Dank, Gruß Frank
Hallo, ich hab doch noch mal eine Frage,
ich mußte das Arbeitsblatt etwas umgestalten.
Das Datum für die Auswahl steht noch auf A1
Allerdings befinden sich die Spalte mit dem Datum jetzt in Spalte G
wie muß ich den Code anpassen?
Datum = CDate(.Range("A1")) 'Datum laden
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
lzA = Archiv.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Schleife zum Daten ins Archiv kopieren
For Each AC In .Range("G4:G" & lz1)
If CDate(AC.Cells(1, 1)) = Datum Then
AC.Resize(1, 7).Copy Archiv.Cells(lzA, 1)
AC.Resize(1, 7).ClearContents
Application.CutCopyMode = False
lzA = lzA + 1
End If
Next AC
'Schleife zum alte Daten rückwärts löschen
Application.EnableEvents = False
For j = lz1 To 3 Step -1
If .Cells(j, 1) = Empty Then .Rows(j).Delete shift:=xlUp
Next j
Application.EnableEvents = True
Vielen Dank schon mal im Voraus
Gruß Frank
Hallo Frank,
ändere einfach den Spaltenbezug
For Each AC In .Range("G4:G" & lz1)
If CDate(AC.Cells(1, 7) = Datum Then
AC.Resize(1, 7).Copy Archiv.Cells(lzA, 1)
AC.Resize(1, 7).ClearContents
Application.CutCopyMode = False
......
Das sollte es gewesen sein (von Cells(1,1) auf Cells (1, 7)
Aber versuche doch auch mal einfach Formeln zu verstehen, notfalls lernen durch probieren.
Gruß Rudi
Danke, super das passt.
Gruß Frank