Sheets anhand Zellenliste erstellen
Ausgangslage - Was tut dieser Code-Schnipsel?
Erstellt neue Arbeitsblätter anhand einer Liste von Namen. Dabei wird je markierter Zelle ein Arbeitsblatt erstellt. Das Arbeitsblatt erhält den entsprechenden Zelleninhalt als Namen.
Der Quelltext
Option Explicit
Option Compare Text
' Original-Quelltext unter: https://www.online-vba.de/sheets-anhand-zellenliste-erstellen
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de
' Verwendung: Markieren Sie einen Zellenbereich und starten Sie dieses Makro
Public Sub OVBAde_ArbeitsblaetterVonListeErstellen()
Dim oZelle As Object
Dim oNewSheet As Object
Dim lSuccessCounter As Long
Dim lErrCounter As Long
If Workbooks.Count < 1 Then Exit Sub
lErrCounter = 0
lSuccessCounter = 0
'Sicherheitsabfrage
If MsgBox("Sind Sie sicher, dass Sie " & Selection.Cells.Count & _
" neue und leere Arbeitsblätter erstellen wollen?", _
vbExclamation + vbYesNo, "HINWEIS!") = vbYes Then
On Error Resume Next
For Each oZelle In Selection.Cells
If Trim(CStr(oZelle.Value)) <> "" Then
Set oNewSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
oNewSheet.Name = Trim(CStr(oZelle.Value))
If Err.Number <> 0 Then
Err.Number = 0
Err.Clear
Application.DisplayAlerts = False
oNewSheet.Delete
Application.DisplayAlerts = True
lErrCounter = lErrCounter + 1
Else
lSuccessCounter = lSuccessCounter + 1
End If
End If
Next oZelle
On Error GoTo 0
If lErrCounter <> 0 Then
MsgBox lErrCounter & " Arbeitsblätter konnten nicht erstellt werden, " & _
"da ihr Name entweder bereits vorhanden ist oder ungültige Zeichen enthält!" & _
vbCrLf & "Es wurden " & lSuccessCounter & " Arbeitsblätter erstellt.", _
vbInFormation + vbOKOnly, "WARNUNG!"
Else
MsgBox "Es wurden " & lSuccessCounter & " Arbeitsblätter erstellt.", _
vbInFormation + vbOKOnly, "HINWEIS!"
End If
End If
End Sub
Anmerkungen und Hinweise
Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2013.
Die Nutzung erfolgt auf eigene Gefahr.
Bitte denken Sie immer zuerst an eine ausreichende Datensicherung.
Wir können keinen kostenlosen Support anbieten.
Es gelten unsere Nutzungsbedingungen.
