Crear un ciclo por VBA

hola Jose,

no estoy seguro del todo de si te he entendido, pero si quieres haz una prueba con este codigo (aunque es largo, si se
acerca a lo que buscas se podria fragmentar y hacer mas dinamico, aparte de haber otras opciones que lo simplificarian
<sobre todo a la hora de elegir la columna y el criterio>)

prueba con copias, pero asegurate de que las hojas se llamen exactamente como lo has expuesto en tu codigo.

hay un par de detalles (aparte de los que puedan surgir) que tendrias que tener en cuenta:

1º.- no se lo que tienes en las columnas de la c a la m en la hoja de destino, pero quizas convendria que lo borraras
antes de ejecutar la macro, pues sino te pegaria los datos pero si el contenido de estas es mayor que el nuevo, el resto
se mantendrian

2º.- como no estoy muy seguro de si lo que quieres realmenrte es pegar los datos de la columna BC o los de la anterior a
la que elijas para la busqueda (field), que es lo que pareceria por el ej. => buscas en la columna 56 (BD) y copias los
de la 55 (BC) te lo he puesto para el caso de que si sea solo esta pero si fuera lo que te comento (la anterior a Field)
cambia esta parte del codigo=>

.Range("BC" & pF & ":bc" & uF).Copy
' .Range(.Cells(pF, Columna - 1), .Cells(uF, Columna - 1)).Copy

poniendo una comilla simple delante de => .Range("BC" & pF & ":bc" & uF).Copy

y quitando la que hay delante de => ' .Range(.Cells(pF, Columna - 1), .Cells(uF, Columna - 1)).Copy

en definitiva te deberia quedar +/- asi =>

' .Range("BC" & pF & ":bc" & uF).Copy
.Range(.Cells(pF, Columna - 1), .Cells(uF, Columna - 1)).Copy

bueno, pegalo en un modulo 'normal' (una vez copiado el libro => Alt+F11 => en el editor de vba => menu 'Insertar' =>
Modulo (a secas, o normal, etc, pero NO de clase) => y en esta ventana que se te abre pegas este codigo =>

'''-pega desde aqui--´'
'
Sub CicloVba()
Dim Columna As Integer, rngCol As Variant, _
criterio As Long, pF As Long, uF As Long, _
Ref As String, preMsj As String, celda As Range
Do
On Error Resume Next
Application.DisplayAlerts = False
criterio = Application.InputBox(preMsj & _
"Elige un nº entre 4101 y 4112", _
"Elegir criterio", 4101, , , , , 1)
Application.DisplayAlerts = True
On Error GoTo 0
If criterio = False Then GoTo Salir
preMsj = "El numero introducido no es valido." & vbCr
Loop While criterio < 4101 Or criterio > 4112
preMsj = ""
With Sheets("Base de datos 10-1-08")
.Activate
Application.ScreenUpdating = False
Do
On Error Resume Next
Set rngCol = Application.InputBox(preMsj & _
"Selecciona la celda de titulo de la columna " & _
"en donde quieres buscar el nº: " & criterio, _
"Elegir campo de busqueda", "BD1", , , , , 8)
If rngCol = False Then GoTo Salir
Columna = rngCol.Cells(1).Column
If Err.Number <> 0 Or Columna < 2 Or Columna > 104 Then
If preMsj = "" Then preMsj = _
"El rango seleccionado no es correcto" & vbCr
End If
On Error GoTo 0
Loop Until Columna > 1 And Columna < 105
rngCol.CurrentRegion.Sort Key1:=rngCol.Offset(1), _
Order1:=xlAscending, Header:=xlYes
If Application.CountIf(.Columns(Columna), criterio) > 0 Then
With .Range(.Cells(1, Columna), .Cells(65536, Columna).End(xlUp))
Set celda = .Find(criterio, .Cells(1), xlValues)
Ref = celda.Address: pF = celda.Row
Do
uF = celda.Row
Set celda = .FindNext(celda)
Loop While celda.Address <> Ref
Set celda = Nothing
End With
.Range("BC" & pF & ":bc" & uF).Copy
' .Range(.Cells(pF, Columna - 1), .Cells(uF, Columna - 1)).Copy
Sheets("núms. extrac. x rutas ").Cells(4, criterio - 4098) _
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End With
Exit Sub
Salir:
MsgBox "No se ha podido completar la operacion."
End Sub
'
''pega hasta aqui-

un saludo y si ves que te puede valer, si quieres comentas y lo intentamos ajustar y simplificar
Ivan