Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 08:56:40
Über alle Spalten nur €-Werte zählen
26.04.2024 08:08:24
Pivot Vormonatsveränderung
26.04.2024 07:54:11
nur den ersten Eintrag in spalte zählen
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1808to1812
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1808to1812
1808to1812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Blatt umbenennen mit Schleife

Blatt umbenennen mit Schleife
29.01.2021 08:22:31
Lizzel
Guten Morgen zusammen,
ich möchte eine Blatt kopieren, umbenennen und ändern und wieder kopieren,... bis eine bestimmt Bedingung erfüllt ist.
     Do While anzahl2 > 26
nummernkreis2 = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.name = nummernkreis2
Range("B7").Value = nummernkreis2
Dim z As Long, lZ As Long
lZ = Sheets(nummernkreis2).Cells(65536, 2).End(xlUp).Row
For z = lZ To 56 Step -1
With Sheets(nummernkreis2)
If .Cells(z, 1) = "" Then .Rows(z).Delete
End With
Next
anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
Loop

Jetzt habe ich bisher das Problem, das er mir eine Fehlermeldung bringt, weil er ein Element einfügt mit dem selben Namen (den ich ja mit der Inputbox ändern will).
Kann ich das Blatt umbenennen, bevor er es wieder einfügt bzw. gibt es eine andere Möglichkeit diese Meldung zu vermeiden?
Danke schon mal!
Gruß Lars

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blatt umbenennen mit Schleife
29.01.2021 08:49:38
Klaus
Hallo Lars,
im Prinzip funktioniert dein Code, bei mir macht er keine Fehler. Ich vermute, in die Inputbox wird etwas eingegeben was es schon gibt - vielleicht ausgeblendet? Ich würd einfach mal versuchen, den Fehler abzufangen und zu behandeln - habe mir auch erlaubt, deinen Code etwas sauberer zu schreiben:
Sub test()
On Error GoTo hell
Dim z As Long, lZ As Long
Dim NummernKreis2 As String
Dim Anzahl2 As Long
Do While Anzahl2 > 26
NummernKreis2 = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = NummernKreis2
Range("B7").Value = NummernKreis2
With Sheets(NummernKreis2)
lZ = .Cells(.Rows.Count, 2).End(xlUp).Row
For z = lZ To 56 Step -1
If .Cells(z, 1) = "" Then .Rows(z).Delete
Next
End With
Anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
hell:
If Err.Number = 1004 Then
MsgBox ("Dieser Nummernkreis hat bereits eine Wartungskarte!")
Sheets(NummernKreis2).Visible = True
Sheets(NummernKreis2).Activate
Resume
End If
If Err.Number  0 Then
MsgBox "Fehler in Nummernkreiserstellung" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description
End If
End Sub

LG,
Klaus
Anzeige
AW: Blatt umbenennen mit Schleife
29.01.2021 11:15:34
Lizzel
Hallo Klaus,
danke für dein Feedback.
Um Doppelungen zu vermeiden nummeriere ich mit 1,2,3,... durch. Sobald er in der Schleife ist, bringt er dann die Meldung, nach Bestätigung mit 'Ja' übernimmt er dann auch die Eingabe in der Inbox.
Also an der Eingabe kann es ja eigentlich nicht liegen.
AW: Blatt umbenennen mit Schleife
29.01.2021 11:21:14
Klaus
Wie gesagt, bei mir funktioniert es. Ohne deine Datei zu kennen kann ich kaum mehr dazu sagen.
Hinweise:
Ich würde die Nummerierung nicht per Inputbox machen, sondern automatisieren. Dafür müsste ich aber deine "Nummernkreis"-Struktur kennen.
For Z = lz to 56 step - 1
Wenn du nur ein paar dutzend Zeilen und einen halbwegs modernen Computer hast, kein Problem. Im großen gesehen ist diese Variante aber sacklangsam - auch eine Million Zeilen könnte man (ohne Schleife) in wenigen Sekunden durchgehen und die unnötigen löschen. Viele bevorzugen eine solche, elegantere, Lösung schon aus Prinzip.
Wie viele Zeilen hast du? Ich sag mal bis 100 würd ich es lassen wie es ist (verständlicher, einfacher zu warten). Wenn du hier allerdings ein maßgebliches Zeitproblem wahrnimmst, steckt an dieser Stelle das große Optimierungspotential.
Falls du selbst recherchieren willst: per "Autofilter" oder "SpecialCells" lassen sich große Bereiche nach Bedingungen selektieren, ohne eine langsame Schleife zu verwenden.
LG,
Klaus
Anzeige
AW: Blatt umbenennen mit Schleife
29.01.2021 14:09:18
Lizzel
https://www.herber.de/bbs/user/143420.xlsm
Der Nummernkreis wird extern vorgegeben, hier lässt sich leider nichts automatisieren (wobei ich das sehr bedauere...)
I.d.R. kommen nicht mehr wie 10-50 Zeilen zum Einsatz
AW: Blatt umbenennen mit Schleife
01.02.2021 10:37:58
Klaus
Da bin ich wieder.
Hier steigt das Makro aus:
Do While Anzahl2 > 26
Anzahl2 muss natürlich irgenwo her kommen. Ansonsten klappt alles (wenn ich do/loop ausklammere zumindest). Die Warnmeldung "Name bereits ...." verhindere ich indem ich die DisplayAlerts kurz abschalte. Das Erstellen eines neuen Blattes zu einer bereits erstellten Wartungskarte läuft Erwartungsgemäß und gewollt in eine Fehlermeldung. Die Optimierung der 50-Zeilen Schleife habe ich mir geschenkt, das sind nur Bruchteile von Milisekunden.
Option Explicit
Sub test()
On Error GoTo hell
Dim z As Long, lZ As Long
Dim NummernKreis2 As String
Dim Anzahl2 As Long
'Do While Anzahl2 > 26
NummernKreis2 = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
Application.DisplayAlerts = False
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Application.DisplayAlerts = True
ActiveSheet.name = NummernKreis2
Range("B7").Value = NummernKreis2
With Sheets(NummernKreis2)
lZ = .Cells(.Rows.Count, 2).End(xlUp).Row
For z = lZ To 56 Step -1
If .Cells(z, 1) = "" Then .Rows(z).Delete
Next
End With
'Anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
'Loop
hell:
If Err.Number = 1004 Then
MsgBox ("Dieser Nummernkreis hat bereits eine Wartungskarte!")
Sheets(NummernKreis2).Visible = True
Sheets(NummernKreis2).Activate
Resume
End If
If Err.Number  0 Then
MsgBox "Fehler in Nummernkreiserstellung" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description
End If
End Sub

Anzeige
AW: Blatt umbenennen mit Schleife
01.02.2021 10:53:17
Lizzel
Morgen Klaus,
genau vor dem Loop definiere ich doch Anzahl2 mit
Anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
 Call MESortieren
Call Nummerieren
Anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
Do While Anzahl2 > 26
On Error GoTo hell
Dim z As Long, lZ As Long
Dim NummernKreis2 As String
NummernKreis2 = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.name = NummernKreis2
Range("B7").Value = NummernKreis2
ActiveSheet.Rows("30:56").Delete

Anzeige
AW: Blatt umbenennen mit Schleife
01.02.2021 10:54:25
Lizzel
Morgen Klaus,
genau vor dem Loop definiere ich doch Anzahl2 mit
Anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
 Call MESortieren
Call Nummerieren
Anzahl2 = Application.WorksheetFunction.CountA(Range("A30:A999"))
Do While Anzahl2 > 26
On Error GoTo hell
Dim z As Long, lZ As Long
Dim NummernKreis2 As String
NummernKreis2 = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.name = NummernKreis2
Range("B7").Value = NummernKreis2
ActiveSheet.Rows("30:56").Delete

Anzeige
AW: Blatt umbenennen mit Schleife
01.02.2021 13:13:08
Klaus
Ah, dann ist das in meinem Testmakro verrutscht. Zieh die Zeile doch einfach mal nach oben, müsste dann funktionieren.
LG,
Klaus
AW: Blatt umbenennen mit Schleife
01.02.2021 14:18:26
Lizzel
Hallo Klaus,
also der Fehler kann doch nicht vom Zählen der belegten Zeilen kommen.
Der muss doch beim Erstellen und Umbenennen des neuen Blattes entstehen.
Hier kopiere ich ein existierendes Blatt und dann muss ja dort auch der Fehler entstehen.
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Mit 
On Error Resume Next
Soll das zwar verhindert werden, funktioniert bei mir aber trotzdem nicht.
Mich wundert es nur, das es beim Kopieren des ersten Blattes funktioniert und erst beim zweiten Blatt Probleme macht.
Anzeige
AW: Blatt umbenennen mit Schleife
01.02.2021 20:01:54
Piet
Hallo Lars
ich glaube in deinem System gibt es einige schwere Denkfehler? Oder ich verstehe die Aufgabe falsch!
Als erstes verstehe ich diese Funktion nicht: - anzahl = WorksheetFunction.CountA(Range("A30:A999"). Wenn der Wert unter 26 liegt tut sich garnichts! Heisst das jetzt, das du neue Wartungsblaetter erstellst, bis der Wert von "anzahl" erreicht wurde?
Probier bitte mal diesen Code, ohne Garantie das er richtig ist. Bei Rows("30:56").Clear oder Delete verschwinden in Spalte A die grauen Zellen, bei ClearContents bleiben sie erhalten.
mfg Piet
Option Explicit
Public Sub AufgabenZählen()
Dim nummernkreis As String
Dim anzahl As Integer
Dim Test As Worksheet
Dim ok As Variant
anzahl = Application.WorksheetFunction.CountA(Range("A30:A999"))
If anzahl  26
Neu: nummernkreis = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
If nummernkreis = Empty Then Exit Sub   'Abbruch bei Cancel
'Prüfen ob Blatt bereits existiert?
On Error Resume Next
Set Test = Worksheets(nummernkreis)
If Err = 0 Then
ok = MsgBox(nummernkreis & " - dieses Blatt existiert bereits!" & _
vbLf & "Bitte neuen Namen eingeben", vbYesNo)
If ok = vbYes Then GoTo Neu
End If
Worksheets("Wartungskarte").Copy _
after:=Sheets(Sheets.Count)
Range("B7").Value = nummernkreis
If ActiveSheet.Name  "Wartungskarte" Then
ActiveSheet.Rows("30:56").ClearContents
ActiveSheet.Name = nummernkreis
End If
ende:
Loop
End Sub

Anzeige
AW: geschlossen oWt
03.02.2021 11:20:17
Piet
...
AW: Blatt umbenennen mit Schleife
04.02.2021 10:38:52
Lizzel
Hallo Piet,
die ganze Mappe liegt hier:
https://www.herber.de/bbs/user/143420.xlsm
Meine Funktion funktioniert auch noch nicht so, wie ich will. Aber dieses Problem will ich erstmal selber lösen.
Die Schleife, mit dem Kopieren&Umbennen des Blattes, habe ich bisher noch nicht zum Laufen bekommen, deswegen der Thread und der Fokus darauf.
Aber zur Info für dich:
- Jedes Blatt darf nur 26 Aufgaben beinhalten
- Jedes Blatt muss seinen eignen Nummernkreis haben
Bin ich kleinergleich 26 erstelle ich nur eine Karte, bin ich über 26 Aufgaben, soll über eine Schleife solange neue Blätter erstellt werden, bis das "letzte" Arbeitsblatt kleinergleich 26 Aufgaben hat.
Gruß Lars
Anzeige
AW: Blatt umbenennen mit Schleife
04.02.2021 13:21:30
Lizzel
.
AW: Blatt umbenennen mit Schleife
04.02.2021 14:45:35
Piet
Hallo
Sorrz das ich den Thread geschlossen hatte, der faellt heute aus dem Forum raus, landet im Archiv! Dort kannst du dir meine Lösung ansehen, aber nicht mehr antworten!
Ich denke du versteht sofort was ich am Code geaendert habe. Du must die "anzahl" natürlich jedesmal abziehen, damit du Nullwert erreichen kannst. Und bei Rows bitte KEIN Range angeben, oder mit EntireRow = ganze Zeile. Einfacher ist aber meine Programmierung.
Ich hoffe dass das Blatt erstellen jetzt einwandfrei laeuft. Würde mich freuen.
mfg Piet
Option Explicit
Public Sub AufgabenZählen()
Dim nummernkreis As String
Dim Blzahl As Single
Dim anzahl As Integer
Dim Txt As String
anzahl = Application.WorksheetFunction.CountA(Range("A30:A999"))
Blzahl = Int(anzahl / 26) + 1
'MsgBox Meldungstext  (kann auch entfallen)
Txt = "Es werden " & Blzahl & " Blätter erstellt"
If anzahl  0
nummernkreis = InputBox("Bitte Nummernkreis für weitere Wartungskarte eingeben:")
Worksheets("Wartungskarte").Copy
Range("B7").Value = nummernkreis
ActiveSheet.Rows("30:56").Delete
anzahl = anzahl - 26  'anzahl-26 bis Null
Loop
End Sub

Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige