---

Hallo.

Mein Problem; in der Jahrestabelle, wo ich Makros hab für die Berechnung meiner Daten, ist auch das Makro Speichern. Dieses erstellt eine neue Tabelle mit den neuen Namen aus E1.
Soweit kein Problem aber wenn ich bereits gespeichert hab und dann im Nachhinein noch mal speichern möchte unter denn selben „Namen aus E1“ gibt es ein Laufzeitfehler 1004.
Die neue Tabelle wird dann gespeichert als "TabelleX" was ich nicht will.

Natürlich könnte ich zuerst die alte Tabelle löschen und dann Makro Speichern.
Aber „Mann“ ist faul ;-)

Kann mir da wer Helfen?

Hier mein Makro

Code:

---

Sub Speichern()

Private Sub CommandButton4_Click()

Cells.Select
Selection.Copy
Range("d1").Select
Sheets.Add
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Merker = ActiveSheet.Range("e1")
ActiveSheet.Move After:=Sheets(Sheets.Count)
ActiveSheet.Name = Merker

ActiveSheet.Columns("K:AE").Hidden = True
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
ActiveSheet.Range("d1").Select
Sheets("Jahrestabelle").Select
Range("D2").Select
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Versteh ich grad nicht...

Code:

---

Sub ListeSpeichern()
  Worksheets(1).Copy
  ActiveWorkbook.Close True, "D:\Test\" & ActiveSheet.Range("e1")
End Sub

---

speichert Dein sheet(1) unter dem Namen, der in E1 steht. Ist diese Datei schon vorhanden, gibt's ne Abfrage: Überschreiben ja/nein.

Wenn Du diese Nachfrage verhindern willst, mach ein
Application.DisplayAlerts = False
davor und am Ende das
Application.DisplayAlerts = True nicht vergessen!

-----------

1 Kaffee später fällt mir auf, dass Du das Sheet wohl gar nicht als eigene Datei speichern möchtest, sondern nur das Blatt hinten anhängst.

Da wirst Du um eine Prüfung: Name schon vorhanden, wenn ja, lösch das vorhandene Blatt und speicher dann, wenn nein, speicher sofort, nicht drum rum kommen. Faulheit ist ja grad der Grund für's vba, oder? ;-) Wenn Du also eh schon code schreibst, dann machen doch die 3 Zeilen mehr den Kohl auch nicht mehr fett 

Beispiel einer solchen Prüfung: >> klick <<

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Dateianhänge | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

wow das ging ja schnell

Ja, ich möchte nur die Tabelle speichern.

wie schreibe ich das jetzt?
denn so funktioniert das nicht

Merker = ActiveSheet.Range("e1")
ActiveSheet.Move After:=Sheets(Sheets.Count)
ActiveSheet.Name = Merker

    Dim x As Object
    On Error Resume Next
    Set Merker = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False

Bei mir ist es mehr ausprobieren als wissen was ich tue
wie gut das ich kein Hurt Locker bin.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

here we go:

Code:

---

Private Function SheetExists(sname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function

Sub SheetSave()
Dim merker as String
merker = Sheets(1).Range("e1")
If SheetExists(merker) Then Sheets(merker).Delete
Sheets(1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = merker
End Sub

---

Gemein von Dir, dass Du jetzt plötzlich nicht mehr .Copy sondern .Move drin hattest    

Was passiert da oben?
Du hast eine Function namens "SheetExists" erstellt, die der Variable X ein Blatt übergeben möchte, dessen Namen (Dein merker) der Function übergeben wird: If SheetExists(merker)
Functions können im Gegensatz zu Subs Werte zurückgeben.

Wenn diese Function den Rückgabewert True hat, wird das Blatt gelöscht: Then Sheets(merker).Delete

Tipp: Geh den Code schrittweise mit F8 im editor durch, dann siehst Du, wann wohin gesprungen wird und was dabei passiert.
Tipp2: Gewöhn Dir Sachen wie ActiveSheet nicht an, man muß damit höllisch aufpassen, dass das Blatt, was man bearbeiten möchte wirklich das aktive Sheet ist, besser also, man legt das Blatt hart fest (Sheets(1) oder auch Sheets("DeinName"))

Ich hoffe, das war jetzt verständlich, wenn nicht: fragen

[rredit] Ach ja: Die Abfrage "Das Blatt das Sie löschen möchten enthält Daten, möchten Sie wirklich löschen?" Kannst Du wieder mit Application.DisplayAlerts = False am Anfang und True am Ende regeln. [/rredit]

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Dateianhänge | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo.

Hab mein Makro nochmals überarbeitet aber es funktioniert leider nicht ganz.
Er überschreibt zwar die alte Tabelle ohne zu fragen ob er es tun soll.
Aber gleichzeitig wird am Anfang eine TabelleX erzeugt?

Das darf nicht wahr sein und ich weiß nicht warum???

Was mir dann noch fehlt. Beim speichern sollen die Makros aus der Tabelle (Jahrestabelle) nicht mitgespeichert werden in die neue Tabelle.

Wenn ich das hab dann nie wieder Makro!!!

Danke für Unterstützung.

Private Function SheetExists(sname) As Boolean
Application.DisplayAlerts = True

'  Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
Application.DisplayAlerts = False
End Function

Sub Speichern()

Private Sub CommandButton4_Click()

Cells.Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Selection.Columns.AutoFit
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Dim merker As String
merker = Sheets("Jahrestabelle").Range("e1")
If SheetExists(merker) Then Sheets(merker).Delete
Sheets("Jahrestabelle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = merker

Sheets("Jahrestabelle").Select
Range("D2").Select
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi auch nochmal hier,

Mal langsam durchgehen, was Dein Code tut, mit F8, wie oben schon vorgeschlagen:

Code:

---

Option Explicit

Private Function SheetExists(sname) As Boolean
'diese Zeile sollte eher in die Sub, nicht in die Function
'Application.DisplayAlerts = True

'  Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
'Application.DisplayAlerts = False
End Function

Sub Speichern()
'Diese Zeile gehört hier nicht hin, Sub in Sub geht nicht, Aufruf wäre z.B. mit Call Subname möglich
Private Sub CommandButton4_Click()
'alle Zellen des aktiven Sheets selektieren, also kein bestimmtes, sondern das, was *zufällig* grad auf ist
Cells.Select
'Selektion in die Zwischenablage kopieren
Selection.Copy
'ein Sheet vor dem aktiven hinzufügen
Sheets.Add
'In dieses neue Sheet die Zwischenablage einfügen
ActiveSheet.Paste
'Selektion: Spaltenbreite = AutoFit
Selection.Columns.AutoFit
'diese Zeile macht die vorige wieder rückgängig, das Selection.Cloumns.AutoFit sollte wenn dann dahinter
'Formatierung des Sheets in der Zwischenablage übernehmen
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
'Variablendeklaration "merker" (sowas schreib ich lieber gebündelt an den Anfang)
Dim merker As String
'Zuweisung des Werts aus E1 an die Var "merker"
merker = Sheets("Jahrestabelle").Range("e1")
'Abfrage ob merker schon vorh. (hatten wir ja schon geklärt)
If SheetExists(merker) Then Sheets(merker).Delete
'Sheet "Jahrestabelle kopieren und ans Ende stellen
Sheets("Jahrestabelle").Copy After:=Sheets(Sheets.Count)
'Dieses neue Blatt umbenennen
ActiveSheet.Name = merker
'Sheet Jahrestabelle wieder selektieren
Sheets("Jahrestabelle").Select
'dort dann Zelle D2 selektieren
Range("D2").Select
End Sub

---

Zu Deinem posting:
>> Er überschreibt zwar die alte Tabelle ohne zu fragen ob er es tun soll.
Da weiß ich grad nicht, was Du damit meinst, aber mit einem Application.DisplayAlerts = True unterdrückt man halt auch wichtige Warnungen...

>> Aber gleichzeitig wird am Anfang eine TabelleX erzeugt?
Ja, mit Sheets.Add tust Du genau das.

>> Beim speichern sollen die Makros aus der Tabelle (Jahrestabelle) nicht mitgespeichert werden in die neue Tabelle.
Warum? Aber schau mal >> klick << und bei google ;-) Aber Achtung, Du löscht damit den gesamten code, nicht nur den vom Sheet "Jahrestabelle", speicher Dir den code also vorher lieber gut weg ;-)

>> Wenn ich das hab dann nie wieder Makro!!!
WARUM? Aller Anfang ist schwer, aber wenn man's mal hat, machen die echt Spaß siehe Signatur   

Kommst Du mit diesen Kommentaren jetzt weiter? Ich weiß durch widersprüchliche Beschreibung <> Code leider nicht, was Du wirklich willst, aber vorgekauter code ist ja eh langweilig   

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Dateianhänge | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

So langsam wird das ganze logisch und übersichtlich.

Die „Formatierungs- Zeilen“ brauche ich nicht. Warum auch immer???
Die neue Tabelle hat dieselben unterschiedlichen Breiten und Rahmen wie die Jahrestabelle. Super!!! :-)

Was ich noch brauch, oder besser gesagt nicht brauch sind die Makros in den neuen Tabellen. Diese Makros sollen weiter nur in der Jahrestabelle bestehen bleiben.

Wie mache ich das?

Private Function SheetExists(sname) As Boolean
Application.DisplayAlerts = True

'  Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
Application.DisplayAlerts = False
End Function

Private Sub CommandButton4_Click()

Cells.Select
Selection.Copy
Dim merker As String
merker = Sheets("Jahrestabelle").Range("e1")
If SheetExists(merker) Then Sheets(merker).Delete
Sheets("Jahrestabelle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = merker
ActiveSheet.Range("d1").Select
' neuer Problem Bereich

Dim objVBComponent As Object
  If ThisSheet.Name <> "Jahrestabelle" Then
      With ActiveSheet.VBProject
        For Each objVBComponent In .VBComponents
            With objVBComponent.CodeModule
              .DeleteLines 1, .CountOfLines
            End With
        Next
      End With
  End If

Sheets("Jahrestabelle").Select
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Was ich noch brauch, oder besser gesagt nicht brauch sind die Makros in den neuen Tabellen. Diese Makros sollen weiter nur in der Jahrestabelle bestehen bleiben.

Jetzt weiß ich endlich, was Du meinst, also zumindest glaub ich das  
Du hast Deinen code bis jetzt komplett im Sheet stehen, also Dir kein eigenes Modul angelegt, richtig?
Da Du ja Dein Makro über einen Button aufrufst und es nun mal jetzt so gebaut ist: Plan Schnell&Schmutzig (Inspiration von >> klick << ):

Code:

---

Sheets("Jahrestabelle").Copy After:=Sheets(Sheets.Count)
Set vbc = ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.VBProject.VBComponents.Count)
With vbc
    vbc.CodeModule.DeleteLines 1, vbc.CodeModule.CountOfLines
End With

---

Das sollte jetzt den Code vom eben erzeugten Sheet wieder löschen.
Womöglich geht sowas auch eleganter, es darf sich gern jeder hier beteiligen und weitere Vorschläge einbringen ;-)

Generell würd ich für solche Makros aber eher Module verwenden und die Subs in den Modulen wenn nötig mit Call Subname aufrufen.

Wenn Du einen button aus der Formularsteuerlementeleiste nimmst (statt nen ActiveX-Button) kannst Du das Makro direkt zuweisen, ohne Private Sub Button1_Klick(), brauchst also auch überhaupt keinen Code mehr auf dem Blatt "Jahrestabelle" und sparst Dir somit das Löschen.

>> So langsam wird das ganze logisch und übersichtlich.

Das ist schön, vielleicht bleibst Du uns ja doch ne Weile als begeisterter VBA-Anwender erhalten  

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Dateianhänge | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP