Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Datums kopieren und neuen Excel Tabellen speichern
 07.09.2016 22:47:45 Anna
NotSolved
08.09.2016 08:56:50 Gast61592
NotSolved
08.09.2016 16:25:41 Gast70117
NotSolved

Ansicht des Beitrags:
Von:
Anna		 Datum:
07.09.2016 22:47:45		 Views:
1230		 Rating:
     
Antwort:
  Ja
Thema:
VBA Datums kopieren und neuen Excel Tabellen speichern

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

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
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

 

 

 

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Datums kopieren und neuen Excel Tabellen speichern
 07.09.2016 22:47:45 Anna
NotSolved
08.09.2016 08:56:50 Gast61592
NotSolved
08.09.2016 16:25:41 Gast70117
NotSolved