Tabellenblätter löschen
07.02.2006 11:15:34
Mark
ich habe noch folgendes Problem:
Im folgenden Code wird die Kopie eines Druckbereiches erstellt. Die Kopie enthält aber drei Register, wobei nur eines benötigt wird.
Wie kann man diese leeren Register (Tabelle2, Tabelle3) noch vor dem Speichern löschen?
Hier der Code:
Public
Sub Dateikopie()
'Kopie einer Datei ohne Formeln mit Format mur Druckbereich, Register nicht geschützt
Dim InI As Integer
Workbooks.Add
With ThisWorkbook ' Datei mit Code
ActiveWorkbook.SaveAs .Path & "\Kopie_von" & ThisWorkbook.Name ' neue Datei Workbooks.Add
For InI = .Worksheets.Count To 1 Step -1 ' Anzahl Register in ThisWorkbook
If .Worksheets(InI).PageSetup.PrintArea <> "" Then
Sheets.Add
' .Worksheets(InI).Cells.Copy
.Worksheets(InI).Range("Druckbereich").Copy
With ActiveWorkbook.ActiveSheet.Range("A1")
.PasteSpecial Paste:=xlPasteValues ' Werte
.PasteSpecial Paste:=xlFormats ' Formate
End With
ActiveWorkbook.ActiveSheet.Name = .Worksheets(InI).Name
End If
Next InI
Application.CutCopyMode = False 'Zwischenspeicher löschen
Application.DisplayAlerts = False
Worksheets(ActiveWorkbook.Worksheets.Count).Delete
Application.DisplayAlerts = True
MsgBox "Reine Datentabelle gespeichert als: " & .Path & "\Kopie_von" & ThisWorkbook.Name
'Makierung vom Druckbereich aufheben - optischer Grund beim Öffnen der Datei
ActiveWindow.SmallScroll Down:=69
Range("A100").Select
ActiveWindow.SmallScroll Down:=-117
ActiveWorkbook.Close True
End With
End Sub
oder der LINK zur Datei:
https://www.herber.de/bbs/user/30748.xls
Der Code von stammt von Hajo Ziplies.
Danke für jede Antwort
-Mark-