Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
924to928
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Shetts(2) & Sheets (3).Delete

Shetts(2) & Sheets (3).Delete
16.11.2007 17:48:00
Heinz
Hallo Leute
Könnte man in diesen Code der mir ein neues Tab.Blatt in ein neues Workbook einfügt, nicht die Sheets 2 & 3 löschen ?
Also das nur der aktive Sheets in der Arbeitsmappe ist.
Danke Heinz
Option Explicit

Sub cp_wbk()
Dim wbk_neu As Workbook
Dim wbk_alt As Workbook
Dim MyFileName As String
Dim MyPfad As String
Dim MyShape As Shape
Set wbk_alt = ActiveWorkbook
Set wbk_neu = Workbooks.Add
wbk_alt.Activate
MyPfad = ThisWorkbook.Path & "\" 'anpassen
MyFileName = Range("B3") & " " & Format([A6], "mmmm YYYY")
wbk_alt.Sheets(1).Copy before:=wbk_neu.Sheets(1)
For Each MyShape In wbk_neu.Sheets(1).Shapes
If MyShape.AlternativeText  "Neues Monat anlegen" Then MyShape.Delete
Next
wbk_neu.SaveAs MyPfad & MyFileName
wbk_neu.Close
'MsgBox "Sicherung siehe: " & MyPfad & MyFileName
End Sub


6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Lies doch den ActiveSheet.Namen ein ...
16.11.2007 18:41:00
Matthias
Hallo Heinz
Ich habe Deinen Code nicht ausprobiert, aber warum liest Du nicht den Namen des AciveSheet in eine Variable(X) ein. Dann lässt Du eine Schleife über alle Sheets(Worksheets) laufen und fragst den Namen ab.
Ist der Name des Strings der Varaiablen(X) dann löschst Du das Sheets(Worksheets).
Userbild

AW: Lies doch den ActiveSheet.Namen ein ...
16.11.2007 20:02:48
Heinz
Hallo Matthias
Danke für Deine Hilfestellung.
Werde es mal probieren ob ich es hinbekomme.
Danke & Gruß Heinz

AW: Shetts(2) & Sheets (3).Delete
16.11.2007 20:03:46
Gerd
Hallo Heinz,
wenn man nur eins reintut, braucht man keine zwei Sheets löschen :-)

Sub test()
Dim intShNumber As Integer
Dim wbk_alt As Workbook, wbk_neu As Workbook
Set wbk_alt = ThisWorkbook
intShNumber = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wbk_alt = ActiveWorkbook
Set wbk_neu = Workbooks.Add
Application.SheetsInNewWorkbook = intShNumber
wbk_alt.Activate
End Sub


Gruß Gerd

Anzeige
AW: Shetts(2) & Sheets (3).Delete
16.11.2007 20:35:00
Heinz
Hallo Gerd
Habe es jetzt Dank deiner Hilfe jetzt so gemacht.
Da trotzdem ein 2.Sheet im Workbook war .
Danke für Deine Hilfe.
Gruß Heinz

Sub cp_wbk()
Dim wbk_neu As Workbook
Dim wbk_alt As Workbook
Dim MyFileName As String
Dim MyPfad As String
Dim MyShape As Shape
Set wbk_alt = ActiveWorkbook
Set wbk_neu = Workbooks.Add
wbk_alt.Activate
MyPfad = ThisWorkbook.Path & "\" 'anpassen
MyFileName = Range("B3") & " " & Format([A6], "mmmm YYYY")
wbk_alt.Sheets(1).Copy before:=wbk_neu.Sheets(1)
For Each MyShape In wbk_neu.Sheets(1).Shapes
If MyShape.AlternativeText  "Neues Monat anlegen" Then MyShape.Delete
Next
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
wbk_neu.SaveAs MyPfad & MyFileName
wbk_neu.Close
'MsgBox "Sicherung siehe: " & MyPfad & MyFileName
End Sub


Anzeige
AW: Shetts(2) & Sheets (3).Delete
17.11.2007 15:03:09
Gerd
Hallo Heinz,
möglicherweise reicht diese Variablensparversion?

Sub a()
Dim MyShape As Shape, strPfaduDatei As String
Application.ScreenUpdating = False
With ThisWorkbook
strPfaduDatei = .Path & "\" & .Sheets(1).Range("B3") & _
" " & Format(.Sheets(1).Range("A6"), "mmmm YYYY")
.Sheets(1).Copy
End With
For Each MyShape In ActiveSheet.Shapes
If MyShape.AlternativeText  "Neues Monat anlegen" Then MyShape.Delete
Next
ActiveWorkbook.SaveAs strPfaduDatei
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub


Gruß Gerd

Anzeige
AW: Shetts(2) & Sheets (3).Delete
17.11.2007 19:31:35
Heinz
Hallo Gerd
Bis jetzt sehe ich keinen Fehler.
Läuft auf den 1.Blick SUPER !!!
Recht herzlichen Dank.
Gruß Heinz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige