Tabellenblaetter automatisch erstellen und ausfüllen
30.10.2019 10:32:02
Uygar
ich habe ein Tabellenblatt als Vorlage. Dieses soll kopiert werden und jedes Blatt soll anhand einer Liste beschriftet werden.
Das funktionierte mit dem unten aufgeführten Code. Ich habe die Vorlage geändert und demzufolge
Cells(15, 3) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(15, 3))
in
Cells(16, 3) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(16, 3))
Das Makro stoppt und der Debugger markiert diese Zeilen. Wenn ich sie wieder in 15 ändere funktioniert es auch nicht.
Das komische ist, dass es funktioniert hatte. Nachdem ich das Makro unterbrochen habe, geht es trotz Neustart und Neueingabe nicht mehr.
Das gesamte Makro lautet wie folgt, hatte ich auch teils hier aus dem Forum:
[Kann mir bitte auch jemand sagen wie das mit dem Beschleuniger funktioniert?]
Vielen Dank schonmal
Sub Rechnungen_anlegen()
Dim rngMuster As Range, zz As Long, ss As Long
Set rngMuster = Sheets("INV").Columns("A:F")
With Sheets("invoice_no")
For zz = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
MsgBox "Blatt '" & .Cells(zz, 1) & "' bereits vorhanden.", vbInformation
Exit For
End If
Next ss
If ss > Sheets.Count Then
Worksheets.Add after:=Sheets(Sheets.Count)
rngMuster.Copy Cells(1, 1)
Cells(15, 3) = .Cells(zz, 1)
ActiveSheet.Name = CStr(Cells(15, 3))
End If
Next zz
End With
ErrExit:
GetMoreSpeed 0
End Sub
Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long
With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc 0, lngCalc, -4105)
.Cursor = xlDefault
End If
End With
End Sub