Bereits geöffnete Mappe aktivieren VBA
01.07.2016 15:03:20
Christian
Ich hätte folgendes Problem:
Ich möchte aus einer Grundtabelle via VBA Daten von einem bestimmten Anfangsdatum bis zu einem bestimmten Enddatum als CSV-Datei exportieren. Dazu filtere ich die Daten aus der Grundtabelle in ein separates Worksheet zum Output. Dort exportiere ich die Daten mit einem (von hier kopierten) Makro als CSV-Datei.
Jetzt kommt mein Problem: Ich will danach die Daten aus dem Output-Worksheet wieder löschen, weiß aber nicht, wie ich das Worksheet nach dem Export der CSV-Datei wieder als mein "aktives Worksheet" bekomme.
Hier mein Makro:
Private Sub CommandButton1_Click()
Dim anfdat As Date
Dim enddat As Date
Dim aktdat As Date
Dim anfzeil, endzeil, zaehler, zaehler2, i As Integer
Dim debi As String
Dim betrag As Currency
Dim Verzeichnis, Datei, urdatei As String
Worksheets("Grundtabelle").Activate
zaehler = 2
zaehler2 = 2
aktdat = 0
anfdat = CDate(TextBox1)
enddat = CDate(TextBox2)
Verzeichnis = ActiveWorkbook.Path & "\" 'Pfad der Textdatei = Pfad des offenen Dokumentes
Datei = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "csv" 'Name der Textdatei = _
Name des offenen Dokumentes, Format csv
urdatei = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "xlsm"
Do Until Cells(zaehler, 1).Value = ""
If CDate(Cells(zaehler, 1).Value) >= anfdat And CDate(Cells(zaehler, 1).Value) Das Makro CSVSpeichern sieht so aus:
Public Sub CSVSpeichern()
'Das aktuelle Blatt als CSV Datei abspeichern
Dim Bereich As Range
Dim iRow As Integer, iCol As Integer
Dim Zeilen As Long, Spalten As Integer
Dim sTxt As String
Dim Verzeichnis As String
Dim Datei As String
'Leere Textdatei erstellen
Verzeichnis = ActiveWorkbook.Path & "\" 'Pfad der Textdatei = Pfad des offenen Dokumentes
Datei = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "csv" 'Name der Textdatei = _
Name des offenen Dokumentes, Format csv
'Zieldatei befüllen
On Error GoTo ERRORHANDLER
Close
Open Verzeichnis & Datei For Output As #1 'Textdatei öffnen und als Output festlegen
On Error GoTo 0
Set Bereich = Range("A1").CurrentRegion
Spalten = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Rows(1)).Count
Zeilen = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Columns(1)).Count
For iRow = 1 To Zeilen
For iCol = 1 To Spalten
sTxt = sTxt & Cells(iRow, iCol).Value & ";"
Next iCol
'___letztes Trennzeichen entfernen
sTxt = Left(sTxt, Len(sTxt) - 1)
Print #1, sTxt
sTxt = ""
Next iRow
MsgBox "Die Datei " & Datei & " wurde im gleichen Verzeichnis erstellt!"
End
ERRORHANDLER:
MsgBox "Achtung, ein Fehler ist aufgetreten!"
End Sub
Trotz der Delete-Schleife bleiben die Datensätze im Reiter "OutputMakro" bestehen.
Kann mir jemand einen Tipp geben?