Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  VBA Datums kopieren und neuen Excel Tabellen speichern

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  VBA Datums kopieren und neuen Excel Tabellen speichern (1028 mal gelesen)
VBAnna
Mitglied


Sehen Sie sich das Profil von VBAnna an!   Senden Sie eine Private Message an VBAnna  Schreiben Sie einen Gästebucheintrag für VBAnna

Beiträge: 4
Registriert: 01.09.2016

erstellt am: 07. Sep. 2016 22:56    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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.

Gruß, 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

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

HenryV
Mitglied
Konstrukteur, Engineering


Sehen Sie sich das Profil von HenryV an!   Senden Sie eine Private Message an HenryV  Schreiben Sie einen Gästebucheintrag für HenryV

Beiträge: 778
Registriert: 18.05.2005

SolidWorks 2020 x64 SP3.0
Dell Precision 5820
Intel Xeon W-2125 4x4GHz
NVIDIA Quadro P2000 5GB
32GB RAM
2x Dell U2412M, 24" TFT
Windows 10 Enterprise x64 21H1
Microsoft Office 365 ProPlus
Microsoft Visual Studio Enterprise 2022

erstellt am: 08. Sep. 2016 16:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für VBAnna 10 Unities + Antwort hilfreich

Hallo Anna

die Zeilen

Code:
If Format(Cells(i + 1, 1), "YYYYMMDD") = Format(Cells((i), 1), "YYYYMMDD") Then
    i = i + 1
End If
musst du mit einer Schlaufe ersetzen, sonst werden nur 3 Zeilen kopiert.
Code:
Do While Format(Cells(i + 1, 1), "YYYYMMDD") = Format(Cells((i), 1), "YYYYMMDD")
    i = i + 1
Loop


Dies

Code:
Do Until Range("A2") = " "
führt zu einer Endlosschleife.
Besser wäre
Code:
Do Until Trim(Range("A2").Value) = ""

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

VBAnna
Mitglied


Sehen Sie sich das Profil von VBAnna an!   Senden Sie eine Private Message an VBAnna  Schreiben Sie einen Gästebucheintrag für VBAnna

Beiträge: 4
Registriert: 01.09.2016

erstellt am: 08. Sep. 2016 17:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Dankeschön, es klappt nun endlich 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz