Re: Makro zum Löschen von Tabellenblättern

Sub Makro1() ActiveSheet.Unprotect Password:="PASSWORT" Dim wks Application.DisplayAlerts = False Application.ScreenUpdating = False Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select For Each wks In ActiveWorkbook.Worksheets If wks.Name ActiveSheet.Name Then wks.Delete End If Next Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show ActiveSheet.Protect Password:="PASSWORT" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro1() ActiveSheet.Unprotect Password:="PASSWORT" Dim wks Application.DisplayAlerts = False Application.ScreenUpdating = False Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False ActiveSheet.Paste For Each wks In ActiveWorkbook.Worksheets If wks.Name ActiveSheet.Name Then wks.Delete End If Next Cells.Select Selection.Copy Workbooks.Add Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show ActiveSheet.Protect Password:="PASSWORT" End Sub

Sub Makro1() Sheets("Tabelle1").Copy ActiveSheet.Unprotect Password:="PASSWORT" ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value ActiveSheet.Protect Password:="PASSWORT" Application.Dialogs(xlDialogSaveAs).Show End Sub

Sub Makro1() ActiveSheet.Unprotect Password:="PASSWORT" Dim wks Application.DisplayAlerts = False Application.ScreenUpdating = False Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False ActiveSheet.Paste For Each wks In ActiveWorkbook.Worksheets If wks.Name ActiveSheet.Name Then wks.Delete End If Next Cells.Select Selection.Copy Workbooks.Add Selection.PasteSpecial Application.CutCopyMode = False Range("A1").Select Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show ActiveSheet.Protect Password:="PASSWORT" End Sub

Funktioniert leider auch nicht, liegt wohl an meiner Datei (kann ich hier auch nicht hochladen, ist zu groß).
Das Problem war auch eigenlich vielmehr, dass bei dem unten stehenden Makro alles klappt, nur wenn ich in dem geöffenten "Speichern unter" Fenster auf "Abbrechen" klicke, hat er natürlich alles wie gewünscht in Werte umgerechnet und alle anderen Tabellenblätter gelöscht.
Nur leider hat er das in der bestehenden Arbeitsmappe gemacht, sodass alle Daten und Blätter der ursrünglichen Mappe, wenn man sie nicht vorher abgespeichert hat, verloren sind!


Sub Makro1()
ActiveSheet.Unprotect Password:="MFSI731$$"
Dim wks
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Paste
For Each wks In ActiveWorkbook.Worksheets
If wks.Name  ActiveSheet.Name Then
wks.Delete
End If
Next
Cells.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show
ActiveSheet.Protect Password:="MFSI731$$"
End Sub

Sub Makro1() Dim shQuelle As Worksheet Dim shZiel As Worksheet ActiveSheet.Unprotect Password:="PASSWORT" Dim wks Application.DisplayAlerts = False Application.ScreenUpdating = False Set shQuelle = ActiveSheet Workbooks.Add Set shZiel = ActiveSheet shQuelle.Cells.Copy shZiel.Cells(1, 1).PasteSpecial xlPasteValues 'Nur Werte übernehmen shZiel.Cells(1, 1).PasteSpecial xlPasteFormats 'Format übernehmen Application.CutCopyMode = False Range("A1").Select Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show ActiveSheet.Protect Password:="PASSWORT" 'Schutz für neue Mappe '-------Mappe1 ändern in den Namen Deiner Org. Mappe--------- Workbooks("Mappe1").ActiveSheet.Protect Password:="PASSWORT" 'Schutz alte Mappe End Sub

Beliebteste Forumthreads (12 Monate)

Re: Makro zum Löschen von Tabellenblättern

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Re: Makro zum Löschen von Tabellenblättern

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread