Utilidad de macros en filas

Te mando mi solución, sigue mi ejemplo:

Tenemos tus datos en la columna A desde A1 hacia abajo e inicialmente los tenemos todos juntos sin filas en blanco.

-Primero ordena alfabéticamente la columna para que estén agrupadas las referencias.

-Después de ordenar solo tienes que ejecutar esta macro:

Sub prueba()
'por luismondelo
Range("a65000").End(xlUp).Offset(1, 0).Value = "final"
Do While ActiveCell.Value <> "final"
valor = ActiveCell.Value
contarsi = Application.WorksheetFunction.CountIf(Columns(1), valor)
If contarsi < 10 Then
filas = 10 - contarsi
Do While ActiveCell.Value = valor
ActiveCell.Offset(1, 0).Select
Loop
End If
For x = 1 To filas
ActiveCell.EntireRow.Insert
Next
ActiveCell.End(xlDown).Select
Loop
End Sub

recuerda finalizar la consulta

Buenas tardes, Luís.

Se me presenta un error, cuando lleva realizada la mitad de la lista aprox. comienza a insertar espacios en blancos sin límite. me gustaría poder adjuntarte el excel para que lo pudieras visualizar. Te adjunto mi correo: [email protected]

A la espera de tu respuesta, muchas gracias.

[email protected]

Mándame solo esa hoja con los datos anotados en la columna A

Hola Luís, la formula que me has presentado en el primer comentario es correcta, lo único es que cuando un valor tiene más de diez filas, comienza un bucle insertando filas vacías. Para curarme en salud voy a poner 20 filas para que no suceda este error, supongo que cambiando los valores de diez a veinte sera suficiente, no??? muchas gracias, por tu colaboración.

PD: a la espera de tu respuesta.

Un saludo,

Francisco.

Para arreglar eso la macro quedaría así:

Sub prueba()
'por luismondelo
Range("a65000").End(xlUp).Offset(1, 0).Value = "final"
Do While ActiveCell.Value <> "final"
valor = ActiveCell.Value
contarsi = Application.WorksheetFunction.CountIf(Columns(1), valor)
If contarsi < 10 Then
filas = 10 - contarsi
Do While ActiveCell.Value = valor
ActiveCell.Offset(1, 0).Select
Loop
Else
Do While ActiveCell.Value = valor
ActiveCell.Offset(1, 0).Select
Loop
GoTo salto
End If
For x = 1 To filas
ActiveCell.EntireRow.Insert
Next
ActiveCell.End(xlDown).Select
salto:
Loop
ActiveCell.ClearContents
End Sub