Macro que no funciona bucle

Hola expertos. He creado esta macro que busca en una lista y crea hojas con datos de una hoja. El problema es que me crea las 2 primeras hojas bien pero a partir de ahí no me crea las hojas bien. Se que el problema está en como hice el bucle pero no se como arreglarlo. Os pongo en negrita el bucle que hice que no funciona.
¿Me ayudáis? Gracias
Sub Copiar_datos_de_los_técnicos()
Application.ScreenUpdating = False ' Hace invisible los movimientos de pantalla
Range("A1101").Select 'Nos colocamos para buscar la lista
While ActiveCell <> "" 'repite el proceso hasta encontrar una celda vacía en col A
Sheets(1). Select 'Seleccionamos hoja 1
nombreHoja = ActiveCell. Value 'guarda el valor de la celda activa para colocarlo como nbre de hoja
On Error Resume Next 'controla posible error por nombre no apto
ActiveWorkbook.Sheets.Add After:=Worksheets(Sheets.Count) 'agrega 1 hoja a continuación de la última
ActiveSheet.Name = nombreHoja 'Pone nombre a la hoja
ActiveSheet.Range("A1:AB100").Clear 'Borra donde se va a copiar
Sheets(1). Select 'vuelve a la hoja original
crit = nombreHoja 'El dato a buscar lo toma de nombreHoja
Sheets(1).Select 'Selecciona la hoja1
ActiveSheet.Range("A1").Select 'Selecciona la celda A1
Selection.AutoFilter 'Quita o pone autofiltro
ActiveSheet.Range("$A$1:$AV$1100").AutoFilter Field:=2, Criteria1:=crit 'ajustar rango total a filtrar. Field:= indica la col a filtrar
ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy 'copia el rango filtrado
Sheets(Sheets.Count).Select 'Selecciona la última hoja
ActiveSheet.Range("A1").Select 'Selecciona celda A1
ActiveSheet.Paste 'Pega los datos copiados
Application.CutCopyMode = False 'Quita la selección de copiado
Sheets(1).Select 'Selecciona hoja1
Selection.AutoFilter 'Quita autofiltro
Range("A1101").Select 'Nos colocamos para buscar la lista
ActiveCell. Offset(1, 0). Select 'avanza 1 fila hacia abajo
Wend 'repite el bucle
End Sub