Lo he modificado para que te valga hasta 1000 elementos en la hoja Generador. Si necesitas más, solo tendrás que sustituir los 1000 por más en la macro.
Sub listas()
Application.ScreenUpdating = False
Sheets("Generador").Activate
Range("A8:A100").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("X1"), Unique:=True
Sheets("Generador").Activate
Columns("X:X").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort.SortFields.Add Key _
:=Range("X1:X31"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
Range("Z2").FormulaLocal = "=SI(X2="""";"""";CONCATENAR(X2;""("";BUSCARV(X2;$A$9:$B$1000;2;FALSO);"")""))"
Range("Z2").Select
Selection.AutoFill Destination:=Range("Z2:Z31")
Sheets.Add
ActiveSheet.Name = "Temp"
Sheets("Generador").Select
Range("A7").Select
Selection.AutoFilter
Range("X1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Set MyRing = Selection
Range("A1").Select
n = 0
For Each Mycell In MyRing
If Mycell.Value = "" Then GoTo fin:
Selection.AutoFilter
ActiveSheet.Range("$A$8").AutoFilter Field:=1, Criteria1:=Mycell
Name = Range("Z1").Offset(1 + n, 0).Value
Range("A9:K1000").Copy Sheets("Temp").Range("A1")
Sheets("Temp").Select
filas = WorksheetFunction.CountA(Range("A1:A1000"))
n = n + 1
J = 1
w = 0
If filas > 17 Then
hojas = Int((filas / 17) + 1)
For i = 1 To hojas
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name & "(" & J & ")"
Sheets("Temp").Select
Range(Cells(1 + w, 2), Cells(17 + w, 11)).Copy Sheets(Name & "(" & J & ")").Cells(12, 2)
w = w + 17
J = J + 1
Next
Else
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name
Sheets("Temp").Select
Range("B1:K17").Copy Sheets(Name).Range("B12")
End If
Sheets("Temp").Range("A1:K1000").ClearContents
Sheets("Generador").Select
Selection.AutoFilter
Next
fin:
Application.DisplayAlerts = False
Sheets("Temp").Delete
Sheets("Generador").Select
ActiveSheet.ListObjects("Tgen").Range.AutoFilter Field:=1
Columns("X:Z").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Un saludo
https://www.dropbox.com/s/tpshwcgkvqa9c6g/prueba%20final%203.xlsm?dl=0