Inserta celdas en blanco y ordena

Vamos a ver si te entiendo porque en tu consulta hay dos opciones:
1º Si falta el número que lo ponga
¿2º O si falta el numero que te ponga una celda en blanco?
Aclarame esto
>Un saludo
>Julio
PD: Tiene guasa la cosa porque no podemos insertar fila porque entonces en la columna contigua quedaría una celda en blanco, hay que seleccionar todo desde la que falta hasta el final cortarlo pegarlo una celda más abajo y en la celda en blanco insertar el numero consecutivo respecto al anterior...

Estimado experto
Gracias por contestar
de tu duda seria la opcion de dejar la celda en blanco o en su caso poner cualquier simbolo o caracter (---, ***, +++, etc)
El chiste es diferenciar o hallar cual numero es el que falta y ubicarlo más fácil
Gracias por tu tiempo

Vale ya está, mira pones esta macro en un modulo y la ejecutas como quieras desde un botón o directamente en VBA. Esta pensada para las Col A y B y para los valores que tu has puesto, desde 18900 hasta 18999 para A y 19000 hasta 19099 para B. No me he preocupado de si empieza en esos números lo he dado por hecho, si no empieza en 18900 y 18999 tendría que modificar la macro, me lo dices.
Sub Insertar_Consecutivo()
Dim valor As String
Dim diferencia As Long
Range("A1").Select
valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.Value <> ""
diferencia = ActiveCell.Value - valor
If diferencia = 1 Then
valor = ActiveCell.Value
End If
If diferencia <> 1 Then
Range(ActiveCell, "A100").Select
Application.CutCopyMode = False
Selection.Cut
ActiveCell.Offset(diferencia - 1, 0).Select
ActiveSheet.Paste
valor = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = "" And ActiveCell.Offset(-1, 0).Value <> 18999 Then
Do While ActiveCell.Offset(-1, 0).Value <> 18999
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
ActiveCell.Offset(1, 0).Select
Loop
End If
Range("B1").Select
valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.Value <> ""
diferencia = ActiveCell.Value - valor
If diferencia = 1 Then
valor = ActiveCell.Value
End If
If diferencia <> 1 Then
Range(ActiveCell, "B100").Select
Application.CutCopyMode = False
Selection.Cut
ActiveCell.Offset(diferencia - 1, 0).Select
ActiveSheet.Paste
valor = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = "" And ActiveCell.Offset(-1, 0).Value <> 19099 Then
Do While ActiveCell.Offset(-1, 0).Value <> 19099
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
ActiveCell.Offset(1, 0).Select
Loop
End If
End Sub
Pruebalá y me dices.
>Un saludo
>Julio
PD: Si te ha servido comenta, puntúa y finaliza la consulta.

Muchas gracias por contestar funciona de maravilla, solo que como tengo columnas desde la A hasta la HD solo funciona con 2 y para más seria enorme la macro.
Pues nada más quiero que haga el ordenamiento de una columna y pues tendré que hacerlo por columnas cambiando el valor de la celda y el numero final de cada columna
ya que intente "quitr la segunda parte y ya no me funciono, así que si me puedes ayudar en eso por ultimo te lo agradeceré
De antemano mil gracias eres un excelente experto

Ahora ya no te entiendo, en la consulta me pones que solo necesitas realizar la labor en 2 Columnas y ahora me dices que esto lo tienes que hacer en 28 columnas más y evidentemente los números primero y ultimo cambian.
En fin, haber si te la dejo para una columna única:
Sub Insertar_Consecutivo()
Dim valor As String
Dim diferencia As Long
Range("A1").Select
valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.Value <> ""
diferencia = ActiveCell.Value - valor
If diferencia = 1 Then
valor = ActiveCell.Value
End If
If diferencia <> 1 Then
Range(ActiveCell, "A100").Select
Application.CutCopyMode = False
Selection.Cut
ActiveCell.Offset(diferencia - 1, 0).Select
ActiveSheet.Paste
valor = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = "" And ActiveCell.Offset(-1, 0).Value <> 18999 Then
Do While ActiveCell.Offset(-1, 0).Value <> 18999
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
ActiveCell.Offset(1, 0).Select
Loop
End If
End Sub
Tendrás que cambiar los valores de los números, las referencias de celdas la A por la B después por la C en cada parte que te las encuentres de la macro.
Mira aver si te lo soluciona.
>Un saludo
>Julio
Si es así puntúa y finaliza la consulta.