Anzeige
Archiv - Navigation
564to568
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
564to568
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

TB automatisch hinzufügen

TB automatisch hinzufügen
13.02.2005 11:51:22
HeinzH
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)

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 12:18:05
andre
Hallo Heinz,
ein sheet fügst Du eigentlich nur mit 2 Worten an:
Sheets.Add
AW: TB automatisch hinzufügen
13.02.2005 12:26:43
HeinzH
Hallo Andre
Ich habe von VBA soviel Ahnung, wie ein Schwein vom Weitspringen.Könntest Du mir BITTE den Code umändern.
Danke
Heinz
AW: TB automatisch hinzufügen
13.02.2005 12:40:21
andre
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
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 12:52:59
HeinzH
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
AW: TB automatisch hinzufügen
13.02.2005 13:02:14
andre
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.
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 13:06:00
Kurt
hi andre,
zitat: " Dann wird auf dem Original der Blattschutz wieder gesetzt."
eben nicht !
siehe meinen versuch einer erklärung
...und Tschüss Kurt
AW: TB automatisch hinzufügen
13.02.2005 12:43:15
Kurt
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
AW: TB automatisch hinzufügen
13.02.2005 12:49:01
HeinzH
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
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 13:03:11
Kurt
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

Anzeige
AW: TB automatisch hinzufügen
13.02.2005 13:39:02
andre
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
@ andre
13.02.2005 16:34:56
Kurt
upps,
sorry
du hast natürlich Recht
mit 'ner Variablen funktionierts natürlich
...und Tschüss Kurt
AW: TB automatisch hinzufügen
13.02.2005 13:03:11
HeinzH
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

Anzeige
AW: TB automatisch hinzufügen
13.02.2005 13:13:14
andre
... 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
AW: TB automatisch hinzufügen
13.02.2005 13:28:45
HeinzH
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
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 13:46:16
andre
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
...
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 16:45:22
HeinzH
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
AW: TB automatisch hinzufügen
13.02.2005 17:55:53
Kurt
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
Anzeige
AW: TB automatisch hinzufügen
13.02.2005 18:03:22
HeinzH
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
AW: TB automatisch hinzufügen
13.02.2005 18:08:11
andre
Hallo Heinz,
Du wolltest den Blattschutz auf der Quelle und nicht auf dem Ziel ...
Ansonsten so
...
zielwks.Protect "Passwort"
end with
...
Grüße, andre
AW: TB automatisch hinzufügen
13.02.2005 18:11:05
Kurt
als letzte zeile im makro einfügen:
zielwks.Protect "Passwort"
und Tschüss Kurt
AW: TB automatisch hinzufügen - Herzlichen Dank
13.02.2005 18:19:48
HeinzH
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige