Código:
Sub CrearHojasPorValor()
Dim celda As Range
Dim rango As Range
Dim dict As Object
Dim nombreHoja As String
Dim sh As Worksheet
Dim existe As Boolean
If TypeName(Selection) <> "Range" Then
MsgBox "Seleccioná celdas con datos primero.", vbExclamation
Exit Sub
End If
Set rango = Selection
If WorksheetFunction.CountA(rango) = 0 Then
MsgBox "La selección está vacía. Seleccioná celdas con datos.", vbExclamation
Exit Sub
End If
Set dict = CreateObject("Scripting.Dictionary")
For Each celda In rango
nombreHoja = Trim(celda.Value)
If nombreHoja <> "" Then
If Not dict.exists(nombreHoja) Then
dict.Add nombreHoja, 1
existe = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name = nombreHoja Then
existe = True
Exit For
End If
Next sh
If Not existe Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = nombreHoja
End If
End If
End If
Next celda
End Sub
