AW: In Dateien 1 Blatt löschen und je 1 Blatt einfügen
11.01.2011 08:02:26
GERWAS
Holla Helena
mit Kommentar:
Sub blätter_löschen_einfügen()
Dim qDatei, qOrdner, tDatei, tBlatt, nBlatt 'Variablen deklarieren
tBlatt = "Zeit10" 'das ist der Blattname, vom Blatt welches weg soll
nBlatt = "Zeit11" 'das der Blattname vom neuen Blatt
qOrdner = "P:\temp\" 'Pfad zum Ordner wo die Dateien, die bearbeitet werden sollen liegen
qDatei = Dir(qOrdner & "Mappe*.xls") 'Muster-Dateiname, der zu bearbeitenden Dateien
'wenn alle im Ordner zu _
bearbeiten sind nimm "*.xls"
Application.DisplayAlerts = False 'damit excel nicht jedesmal fragt, ob es etwas löschen _
soll
On Error Resume Next 'Fehler abfangen
Do While qDatei "" 'alle dateien abarbeiten
Set tDatei = GetObject(qOrdner & qDatei) 'Datei (verdeckt) öffnen
On Error Resume Next 'eingefügt, um mögliche Fehler zu ignorieren
tDatei.Sheets(tBlatt).Delete 'Blatt löschen, geht aber nur, wenn es auch existiert _
sonst Fehler!
tDatei.Sheets.Add.Name = nBlatt 'neues Blatt einfügen und gleich Namen vergeben
tDatei.Close savechanges:=True 'die Datei speichern und schließen
qDatei = Dir 'nächsten Dateinamen holen, wennn alle durch sind ist qDatei=""
Loop 'weiter oben
Application.DisplayAlerts = True 'Sicherheitsfragen wieder einschalten
On Error Goto 0 ' Fehlerbehandlung wieder abschalten
Set tDatei = Nothing 'Speicher wieder freigeben
End Sub