TB automatisch hinzufügen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 11:51:22





Hallo Leute
Habe mit unterstehenden Code ein kleines Problem.
Habe eine Schaltfläche zum automatischen hinzufügen von TB.wenn ich auf hinzufügen Klickekopiert es mir zuerst eine Kopie vom alten TB und dann erst das neue.Zb Tb Liste1(2) Tb Liste2 .Richtig wäre gleich TB Liste2.
Weiss jemand warum ??
Danke für Eure Hilfe Heinz


Dim wks As Worksheet
Dim zi, JUrl, ETDat, EinfDatE, EinfDatB As Variant
Dim co As Integer
Application.ScreenUpdating = False
co = Sheets.Count
Sheets(co - 1).Unprotect Password:="Passwort"
Sheets(co - 1).Copy Before:=Sheets(co)
Sheets(co - 1).Protect Password:="Passwort"
Application.ScreenUpdating = False
Sheets(Sheets.Count - 1).Copy Before:=Sheets(Sheets.Count)
Set wks = Sheets(Sheets.Count - 1)

Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 12:18:05

Hallo Heinz,
ein sheet fügst Du eigentlich nur mit 2 Worten an:
Sheets.Add


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 12:26:43

Hallo Andre
Ich habe von VBA soviel Ahnung, wie ein Schwein vom Weitspringen.Könntest Du mir BITTE den Code umändern.
Danke
Heinz


Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 12:40:21

Hallo Heinz,
ich weiß ja nicht was Du mit dem code noch alles tun willst .. Zum Blatt hinzufügen reicht das. Wenn Du das Blatt wie im code vor das letzte setzen willst dann mit
Dim wks As Worksheet
Dim zi, JUrl, ETDat, EinfDatE, EinfDatB As Variant
Dim co As Integer
Application.ScreenUpdating = False
co = Sheets.Count
Sheets(co - 1).Unprotect Password:="Passwort"
Sheets(co - 1).Copy Before:=Sheets(co)
Sheets(co - 1).Protect Password:="Passwort"
Application.ScreenUpdating = False
Sheets.Add
activesheet.Move Before:=Sheets(Sheets.count)
Set wks = activesheet


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 12:52:59

Hallo Andre
Ich möchte die vorletzte Kopieren.Vor dem Kopieren sollte der Blattschutz geöffnet werden
wegen Verknüpfungen und nach kopieren wieder automatisch gesetzt werden.
Blattschutz öffnen das funktioniert aber dann wieder automatisch nach kopieren Blattschutz setzen das funkt.leider nicht.
Hättest Du bitte eine Hilfe für mich ??
Danke Heinz


Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 13:02:14

Hallo Heinz,
mit dem code wird erst das vorletzte Blatt kopiert, und zwischen diesem und dem letzten eingefügt.
Dann wird auf dem Original der Blattschutz wieder gesetzt.
Dann wird zwischen dem neuen Blatt und dem letzten Blatt noch ein neues Blatt eingefügt.
Das funktioniert auch, was geht den bei Dir nicht?
Die Reihenfolge ob Du nun erst das Original kopierst und dann noch ein neues Blatt einfügst oder umgekehrt spielt dabei keine Rolle.


Bild


Betrifft: AW: TB automatisch hinzufügen von: Kurt
Geschrieben am: 13.02.2005 13:06:00

hi andre,
zitat: " Dann wird auf dem Original der Blattschutz wieder gesetzt."
eben nicht !
siehe meinen versuch einer erklärung
...und Tschüss Kurt


Bild


Betrifft: AW: TB automatisch hinzufügen von: Kurt
Geschrieben am: 13.02.2005 12:43:15

hi Heinz,
du hast zweimal copy drin
welche tabelle willst du nun kopieren ?
die wo der button drauf ist oder die vorletzte in der mappe ?
und wie gehts dann weiter ?
und Tschüss Kurt


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 12:49:01

Hallo Kurt
Ich möchte die vorletzte Kopieren.Vor dem Kopieren sollte der Blattschutz geöffnet werden
wegen Verknüpfungen und nach kopieren wieder automatisch gesetzt werden.
Blattschutz öffnen das funktioniert aber dann wieder automatisch nach kopieren Blattschutz setzen das funkt.leider nicht.
Hättest Du bitte eine Hilfe für mich ??
Danke Heinz


Bild


Betrifft: AW: TB automatisch hinzufügen von: Kurt
Geschrieben am: 13.02.2005 13:03:11

hi Heinz,
das kommt davon wenn man die tips nicht umsetzt ;-)
jetzt mal dein fehler erklärt:
Sheets(co - 1).Unprotect Password:="Passwort"
'hier hebst du den schutz für die vorletzte tabelle auf
Sheets(co - 1).Copy Before:=Sheets(co)
hier kopierst du die vorletzte und machst die neue tabelle zur vorletzten !!
Sheets(co - 1).Protect Password:="Passwort"
hier setzt du den schutz auf die NEUE vorletzte tabelle

und jetzt mal richtig:

Sub kopiereBlatt()
Dim quellwks As Worksheet
Dim zielwks As Worksheet
Set quellwks = Sheets(Sheets.Count - 1)
Application.ScreenUpdating = False
quellwks.Unprotect "123"
quellwks.Copy Before:=Sheets(Sheets.Count)
quellwks.Protect "123"
'activesheet ist jetzt die kopie !!
Set zielwks = ActiveSheet
zielwks.Name = quellwks.Range("A6") & " bis " & quellwks.Range("A52")
'... und dein weiterer code
End Sub



Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 13:39:02

Hallo Kurt,
kleiner Irrtum Deinerseits: Der Schutz wird auf dem Blatt co-1 gesetzt. Das ist nach dem Einfügen eines neuen "vorletzen" Blattes immer noch das alte vorletzte Blatt, denn die Variable co hat sich nicht geändert.
Grüße, Andre


Bild


Betrifft: @ andre von: Kurt
Geschrieben am: 13.02.2005 16:34:56

upps,
sorry
du hast natürlich Recht
mit 'ner Variablen funktionierts natürlich
...und Tschüss Kurt


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 13:03:11

Hallo Andre & Kurt
Habe zum besseren Verständnis den ganzen Code eingefügt.Das neue TB hatt die Bezeichnung vom alten TB A6 & A52
Gruss Heinz

Sub kopiereBlatt()
Dim wks As Worksheet
Dim zi, JUrl, ETDat, EinfDatE, EinfDatB As Variant
Dim co As Integer
Application.ScreenUpdating = False
co = Sheets.Count
Sheets(co - 1).Unprotect Password:="Passwort"
Sheets(co - 1).Copy Before:=Sheets(co)
Sheets(co - 1).Protect Password:="Passwort"
Application.ScreenUpdating = False
Sheets(Sheets.Count - 1).Copy Before:=Sheets(Sheets.Count)
Set wks = Sheets(Sheets.Count - 1)
With wks
    '.Name = .Range("A6") & " bis " & .Range("A52")
     .Range("A6") = .Range("A52") + 3
     .Range("M58:M60") = .Range("O58:O60").Value
     
     'eingefügt von Stephan(HerberForum)Berechnung für Urlaub
     ETDat = Sheets("Legende").Range("D3").Value
     EinfDatB = .Range("A6").Value - 2
     EinfDatE = .Range("A52").Value
     
     For zi = 1 To 500
     ETDat = DateSerial(Year(ETDat) + 1, Month(ETDat), Day(ETDat))
     If ETDat >= EinfDatB And ETDat <= EinfDatE Then
     
     JUrl = Sheets("Legende").Range("H24").Value * 5
    .Range("M58").Value = .Range("M58").Value + JUrl
    End If
    Next zi
    'Ende eingefügt von Stephan(HerberForum)
     
     
    .Range("J5") = .Range("J55").Value
Application.EnableEvents = False
 .Range("C6:f10,C12:f16,C18:f22,C24:f28").ClearContents
 .Range("C30:f34,C36:f40,C42:C46,C48:f52").ClearContents
 .Range("L6:O10,L12:O16,L18:O22,L24:O28,L30:O34,L36:O40,L42:O46,L48:O52").ClearContents
End With
ActiveWindow.ScrollColumn = 1
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub



Sub löschen()
Application.ScreenUpdating = False
With ActiveSheet
.Range("C6:f10,C12:f16,C18:f22,C24:f28").ClearContents
 .Range("C30:f34,C36:f40,C42:C46,C48:f52").ClearContents
 .Range("L6:O10,L12:O16,L18:O22,L24:O28,L30:O34,L36:O40,L42:O46,L48:O52").ClearContents
End With
Application.ScreenUpdating = True
End Sub



Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 13:13:14

... und willst Du nun nur das vorletzte Blatt kopieren oder soll noch ein Blatt dazukommen, oder beides, oder willst Du es 2x kopieren, und wo willst Du den Blattschutz, auf dem Original, oder auf der Kopie, oder auf beiden ...
Grüße, andre


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 13:28:45

Hallo Andre
Es geht um eine Stundenliste der Name vom Tb werden von den Werten A6 & A52 zB.13.02.2005 bis 15.04.2005 Im TB "Hauptblatt" habe ich die Schaltfläche Blatt hinzufügen. Dann sollte das neue Tb.18.04.2005 bis 25.06.2005 kommen.Dabei muß der Blattschutz beim Tb 13.02.2005 bis 15.04.2005 zum kopieren aufgehoben werden,nach dem kopieren wieder gesetzt werden.
Gruß Heinz


Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 13:46:16

Hallo Heinz,
irgendwie hatte ich auf eine einfache Antwort gehofft, und es wird immer komplizierter.
Also, dass Blatt 13.02.2005 bis 15.04.2005 ist gerade das vorletzte Blatt. Das willst Du kopieren.
Da liegt Dein Problem weniger beim Passwort. Nach dem Kopieren ist das neue Blatt das aktive, und da liegt der Hase im Pfeffer ;-)
Versuchs mal so, das dürfte einfacher werden als der Weg von Kurt.
Dim wks As Worksheet
Dim zi, JUrl, ETDat, EinfDatE, EinfDatB As Variant
Dim co As Integer
Application.ScreenUpdating = False
co = Sheets.Count
Sheets(co - 1).Unprotect Password:="Passwort"
Sheets(co - 1).Copy Before:=Sheets(co)
Sheets(co - 1).Protect Password:="Passwort"
Sheets(co - 1).Activate 'altes Blatt aktivieren um die Daten zu übernehmen
Set wks = Sheets(Sheets.Count - 1) 'neues Blatt als wks setzen
...


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 16:45:22


Hallo Kurt & Andre
Hatte plötzlich Probl. mit meinen PC. Grund ??? Aber jetzt läuft er wieder.

Komme einfach nicht zum Erfolg,bin noch zu unerfahren mit VBA habe meine Datei hochgeladen.Könntet Ihr BITTE mir damit helfen. Passwort ist "Schöny"
Danke für Eure Hilfe bis jetzt.
Gruß Heinz

https://www.herber.de/bbs/user/18004.xls


Bild


Betrifft: AW: TB automatisch hinzufügen von: Kurt
Geschrieben am: 13.02.2005 17:55:53

hi,
probier mal und teile uns mit wo es jetzt noch hapert:

Sub kopiereBlatt()
    If MsgBox( _
      prompt:="Haben sie vorher den Blattschutz vom vorhergehenden Blatt entfernt?", _
      Buttons:=vbQuestion + vbYesNo _
      ) = vbNo Then Exit Sub
Dim quellwks As Worksheet
Dim zielwks As Worksheet
Set quellwks = Sheets(Sheets.Count - 1)
Application.ScreenUpdating = False
quellwks.Unprotect "Passwort"
quellwks.Copy Before:=Sheets(Sheets.Count)
quellwks.Protect "Passwort"
'activesheet ist jetzt die kopie !!
Set zielwks = ActiveSheet
Dim wks As Worksheet
Dim zi, JUrl, ETDat, EinfDatE, EinfDatB As Variant
With zielwks
    '.Name = .Range("A6") & " bis " & .Range("A52")
     .Range("A6") = .Range("A52") + 3
     .Range("M58:M60") = .Range("O58:O60").Value
    
     'eingefügt von Stephan(HerberForum)Berechnung für Urlaub
     ETDat = Sheets("Legende").Range("D3").Value
     EinfDatB = .Range("A6").Value - 2
     EinfDatE = .Range("A52").Value
     
     For zi = 1 To 500
     ETDat = DateSerial(Year(ETDat) + 1, Month(ETDat), Day(ETDat))
     If ETDat >= EinfDatB And ETDat <= EinfDatE Then
     
     JUrl = Sheets("Legende").Range("H24").Value * 5
    .Range("M58").Value = .Range("M58").Value + JUrl
    End If
    Next zi
    'Ende eingefügt von Stephan(HerberForum)
     
     
    .Range("J5") = .Range("J55").Value
Application.EnableEvents = False
 .Range("C6:f10,C12:f16,C18:f22,C24:f28").ClearContents
 .Range("C30:f34,C36:f40,C42:C46,C48:f52").ClearContents
 .Range("L6:O10,L12:O16,L18:O22,L24:O28,L30:O34,L36:O40,L42:O46,L48:O52").ClearContents
End With
ActiveWindow.ScrollColumn = 1
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub



cu Micha


Bild


Betrifft: AW: TB automatisch hinzufügen von: HeinzH
Geschrieben am: 13.02.2005 18:03:22

Hallo Kurt
Funkt.jetzt richtig mit neuen TB hinzufügen.Nur die Kleinigkeit vom Blattschutz wieder setzen nach kopieren im neuen TB funkt.noch nicht.
Weisst Du auch hier noch eine Lösung ??
Danke Heinz


Bild


Betrifft: AW: TB automatisch hinzufügen von: andre
Geschrieben am: 13.02.2005 18:08:11

Hallo Heinz,
Du wolltest den Blattschutz auf der Quelle und nicht auf dem Ziel ...
Ansonsten so
...
zielwks.Protect "Passwort"
end with
...
Grüße, andre


Bild


Betrifft: AW: TB automatisch hinzufügen von: Kurt
Geschrieben am: 13.02.2005 18:11:05

als letzte zeile im makro einfügen:
zielwks.Protect "Passwort"
und Tschüss Kurt


Bild


Betrifft: AW: TB automatisch hinzufügen - Herzlichen Dank von: HeinzH
Geschrieben am: 13.02.2005 18:19:48

Hallo Andre & Kurt
Ihr seit Meister in Euren Fach,..Ehrlich
Jetzt funkt. alles so wie ich es wollte!!

Vielen herzlichen Dank,für die Mühe und Zeit die Ihr für mein Problem investiert habt.
gruß
Heinz


 Bild

Beiträge aus den Excel-Beispielen zum Thema "TB automatisch hinzufügen"