Como conservar hipervinculos en filtro avanzado

[excelfre]

Buenas tardes, gracias a los miembros de este foro por la ayuda de antemano.

Necesito filtrar datos de varias hojas diferentes y estoy utilizando filtro avanzado. El problema es que no se como conservar los hipervínculos.

Adjunto el ejemplo del que hablo. Un saludo.

 

macro filtro avanzado.rar

[Antoni]

No se puede utilizando la opción de copiar a otra hoja, pero hay un truco para poder hacerlo con el filtro sobre los mismos datos origen.

Prueba la macro de esta manera:

Sub Macro5()
'
' Borrar resultados anteriores
'
   Columns("C:S").ClearContents
   Range("G2").Select

' Filtro avanzado para copiar los datos en la hoja informe
'
   Application.ScreenUpdating = False
   With Sheets("facturas").Columns("G:H")
     .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A2"), Unique:=False
     .SpecialCells(xlCellTypeVisible).Copy Columns("G:H")
     Sheets("facturas").ShowAllData
   End With
       
   With Sheets("contrato").Columns("G:H")
     .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A2"), Unique:=False
     .SpecialCells(xlCellTypeVisible).Copy Columns("O:P")
     Sheets("contrato").ShowAllData
   End With
End Sub

Es algo mas lenta.

[excelfre]

Hace 4 minutos , Antoni dijo:

No se puede utilizando la opción de copiar a otra hoja, pero hay un truco para poder hacerlo con el filtro sobre los mismos datos origen.

Prueba la macro de esta manera:

Sub Macro5()
'
' Borrar resultados anteriores
'
   Columns("C:S").ClearContents
   Range("G2").Select

' Filtro avanzado para copiar los datos en la hoja informe
'
   Application.ScreenUpdating = False
   With Sheets("facturas").Columns("G:H")
     .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A2"), Unique:=False
     .SpecialCells(xlCellTypeVisible).Copy Columns("G:H")
     Sheets("facturas").ShowAllData
   End With
       
   With Sheets("contrato").Columns("G:H")
     .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A2"), Unique:=False
     .SpecialCells(xlCellTypeVisible).Copy Columns("O:P")
     Sheets("contrato").ShowAllData
   End With
End Sub

Es algo mas lenta.

Ha funcionado perfectamente. Muchísimas gracias.