Hey Leute,

ich habe da ein Problem. Ich möchte mittels VBA ein Programm schreiben, dass aus einer Excel Tabelle mit verschiedenen Datums und Uhrzeiten (Spalte A) einzelne Excel Tabellen erstellt und die Datums mit ganzer Zeile reinkopiert. Die neuen Excel Tabellen sollen jeweils von einem Tag (0-23,59Uhr, wenn vorhanden) die Datums einspeichern. Die Excel Tabellen sollen mit dem jeweiligem Tag bezeichnet werden in Form von „JJJJMMTT.xls“.

In Der Spalte A stehen dabei chronologisch geordnete Datums von mehreren Tagen. Jedoch gibt es unregelmäßige Lücken in der Minutenangaben. Man kann also nicht sagen, dass ein Tag aus (24*60) Tagen besteht. Zu jedem Datum in Spalte A soll die ganze Zeile mit kopiert werden.

In Zeile 1 Stehen Überschriften, somit beginnt das Datum erst In Zeile 2. Die Überschriften müssen bei jeder neuen Excel Tabelle mit erhalten bleiben.

Ich habe überlegt, eine Sicherheitskopie zu machen, damit nichts verloren geht. Somit können die kopierten Daten aus meinem Aktiven Worksheet gelöscht werden und der nächste Tag (für das nächste Excel) steht dann in der Zelle A2. Jedoch Funktioniert die Schleife nicht wie geplant. Es wird nur eine Tabelle erstellt und 3 Zeilen kopiert und dann stürzt es bei mir ab.

Es wäre sehr nett, wenn mir dabei jemand helfen kann.

Grüß, Anna

Sub Exceldateien()
    'Variablen Declarieren
        Dim i As Long
        Dim AZeile As Integer
        Dim ASpalte As Integer
        Dim objExcel As Object
        Dim newdate As Date
      
        AZeile = Cells(Rows.Count, 1).End(xlUp).Rows.Row            'Anzahl der Zeilen
        ASpalte = Cells(1, Columns.Count).End(xlToLeft).Column      'Anzahl der Spalten
                                                       
    'Ordner für Zielfunktion anlegen
            MkDir "C:\XXX\Test"                         ' Verzeichnis erstellen, in dem die Dateien erstellt werden (entsprechend anpassen)
'Pfad ändern
    
    'Sicherheitskopie 
                    ActiveSheet.Range("A1", ActiveSheet.Cells(AZeile, ASpalte)).Copy              'Zellen kopieren
                        Workbooks.Add
                    Range("A1", ActiveSheet.Cells(AZeile, ASpalte)).PasteSpecial                  'Zellen einfügen
                    ActiveWorkbook.SaveAs Filename:= _
                    "C:\XXX\Test\" & "Sicherheitskopie" & ".xls"
'Pfad ändern
                        ActiveWorkbook.Close                                                      'gespeichert ohne zu Öffnen
                  
    'Zerlegen der Excel-Tabelle in meherer Tabellen mit jeweils einen Tag (namens:JJJJMMTT.xls)
            With ActiveSheet
                Do Until Range("A2") = " "
                    i = 2
                    newdate = Range("A2")
                            If Format(Cells(i + 1, 1), "YYYYMMDD") = Format(Cells((i), 1), "YYYYMMDD") Then i = i + 1
                            End If
                                With ActiveSheet
                                    ActiveSheet.Range("A1", ActiveSheet.Cells(i, ASpalte)).Copy             'Zellen kopieren
                                        Workbooks.Add
                                    Range("A1", ActiveSheet.Cells(i, ASpalte)).PasteSpecial                 'Zellen einfügen
                                    ActiveWorkbook.SaveAs Filename:= _
                                    "C:\XXX\Test\" & Format(newdate, "yyyymmdd") & ".xls"
'Pfad ändern
                                        ActiveWorkbook.Close
                                End With
                                    Range("A2", ActiveSheet.Cells(i, ASpalte)).Delete Shift:=xlUp
                 Loop
            End With
        
    'Ausgabe das Makro beendet ist
            MsgBox "Dateien erstellt!"
        End Sub