QUE PENA , MENSAJE DE 3 0 4 LINEAS

Mil disculpas es que trate de ser lo mas explicito posible pero se me fue la
mano, gracias por estas instrucciones funciona muy bien pero el problema es
que copia solamente la celda R1 y las demas las deja intactas, lo que
necesito es que copie todas las celdas que tienen valores difrentes de cero
en la columna R sin contar R1 y despues de haber hecho el filtrado que las
copie a partir de la primer celda visible de la columna E.



Muchas gracias por la ayuda la valoro muchisimo.







hola, Luis !

en lo que 'termino de masticar' el resto de tu mensaje [que no son tres o
cuatro lineas]... :))
prueba con algo +/- como lo siguiente [aunque es 'practicamente' lo mismo
que ya te habia sugerido]:...

OJO: si el rango sobre el que se hace el filtro avanzado... [A1:K508]
es -tambien-... 'estimado' -?-
existe la posibilidad de que el 'conteo' de areas no resulte lo 'preciso'
que se requiere por el procedimiento -?-

y... si cualquier duda [o informacion adicional -que no se encuntre en el
mensaje anterior-]... comentas ?
saludos,
hector.

Sub Filtrado_1()
With Range("a1:k508")
.AdvancedFilter _
Action:=xlFilterInPlace, _

CriteriaRange:=Workbooks("colega.xls").Worksheets("registro").Range("q165:v1
66"), _
Unique:=True
With .SpecialCells(xlCellTypeVisible)
On Error GoTo Ninguno
IIf(.Areas(1).Rows.Count > 1, _
.Areas(1).Cells(2, 5), .Areas(2).Cells(1, 5)).Select
End With
End With
With Worksheets("nota")
.Range(.Range("r2"), .Range("r65536").End(xlUp)).Copy ActiveCell
End With
Exit Sub
Ninguno:
MsgBox "Criterios no cumplidos !!!"
End Sub