Seleccionar registros de una hoja según un parámetro dado y dicha selección pasarla a una hoja nueva

Tengo la siguiente rutina, que en un principio, situándome encima del dato que quisiera seleccionar, debería hacer lo que en mi pregunta va expuesto, pero cuando doy a ejecutar me sale el siguiente error:

"Error de Compilación. No se ha definido Sub o Function"

Me puedes echar una mano. Muchas gracias anticipada. Saludos,

Sub MacroConsultaPorEjemplo()


'Extrae los datos según la celda seleccionada
' y crea un nuevo libro


Dim hojaOrigen As Worksheet, hojaDestino As Worksheet
Dim colInicio As Long, colFin As Long
Dim filInicio As Long, filFin As Long
Dim f As Long, c As Long, ff As Long, cc As Long
Dim celdaOrigen As Range, celdaEvaluar As Range
Dim celdaDestino As Variant 'TIENE QUE SER VARIANT POR CULPA DEL MÉTODO COPY
Dim celdaInicio As Range, celdaFin As Range
Dim msg As String


'Recordar la hoja principal

Set hojaOrigen = ActiveSheet
Set celdaOrigen = ActiveCell
If celdaOrigen = "" Then Exit Sub

'Averiguar el número de filas y columnas mirando alrededor
' de la celda seleccionada

Selection.End(xlUp).Select: filInicio = ActiveCell.Row
Selection.End(xlDown).Select: filFin = ActiveCell.Row
Selection.End(xlToLeft).Select: colInicio = ActiveCell.Column
Selection.End(xlToRight).Select: colFin = ActiveCell.Column
If filFin >= 65536 Or colFin >= 256 Then Exit Sub

''Celda con el contenido del filtro
'celdaOrigen.Activate
'Set celdaEvaluar = Cells(filInicio, celdaOrigen.Column)
'msg = "¿Extraer en un nuevo libro [" & celdaEvaluar & "] '" & celdaOrigen & "' ?"
'If vbYes <> MsgBox(msg, vbQuestion + vbYesNo) Then
' Exit Sub
'End If
'Crear la nueva hoja en un nuevo libro
Workbooks.Add
Set hojaDestino = ActiveSheet
Call MacroBorrarRestoHojas
hojaDestino.Name = normalizarNombre(CStr(celdaOrigen))
'Copiar datos fila a fila
ff = 1
For f = filInicio To filFin
'Si es la fila de títulos o está el dato seleccionado
Set celdaEvaluar = hojaOrigen.Cells(f, celdaOrigen.Column)
If f = 1 Or celdaEvaluar = celdaOrigen Then
Set celdaInicio = hojaOrigen.Cells(f, colInicio)
Set celdaFin = hojaOrigen.Cells(f, colFin)
Set celdaDestino = hojaDestino.Cells(ff, 1)
Range(celdaInicio, celdaFin).Copy celdaDestino
ff = ff + 1
End If
Next
'Ajustar
hojaDestino.Cells.EntireColumn.AutoFit
''Restablecer
'hojaOrigen.Activate
'celdaOrigen.Activate
End Sub

0

Añade tu respuesta

Haz clic para o