Tabellenblatt einfügen und speichern
16.01.2023 10:15:12
Romy
Ich bräuchte Hilfe. Ich würde gerne diesen Code benutzen für das speichern eines Tabelleblattes. Gerne würde ich für das neue Tabellenblatt den Namen welcher im Feld B1 steht benutzen. Aktuell steht dort Kunde. Kann mir da wer helfen?
Sub PotenzialNeu()
'Vorlagenblatt kopieren, einfügen und umbenennen mit fortlaufender Nr.
Dim wbAktiv As Workbook
Dim wks As Worksheet
Dim intNrName As Integer
Dim strKopieNeu As String
Const strKopie As String = "Kunde " 'Startext für Name Blatt-Kopie
Const strVorlage As String = "blank" 'Name des Vorlageblattes
Const varEinfuegeBlatt As Variant = "Datenquelle" 'Name oder Nummer des Blatts vor _
dem eingefügt werden soll
Const strFormat As String = "0" 'Format für Zählziffer bei Namen
On Error GoTo Fehler
Set wbAktiv = ActiveWorkbook
'Nummer des Neuen Namens ermitteln
'Es wird die höchste Zählnummer der Namen ermittelt, die mit dem Kopie-Namen beginnnen
For Each wks In wbAktiv.Worksheets
With Application.WorksheetFunction
If LCase(Left(wks.Name, Len(strKopie))) = LCase(strKopie) Then
If IsNumeric(Mid(wks.Name, Len(strKopie) + 1)) Then
intNrName = .Max(intNrName, CLng(Mid(wks.Name, Len(strKopie) + 1)))
End If
End If
End With
Next
'Neuen Namen ermitteln
strKopieNeu = strKopie & Format(intNrName + 1, strFormat)
'Neues Blatt anlegen und Name zuweisen
wbAktiv.Worksheets(strVorlage).Copy before:=wbAktiv.Worksheets(varEinfuegeBlatt)
ActiveSheet.Name = strKopieNeu
Fehler:
With Err
If .Number 0 Then
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End If
End With
End Sub