Como utilizar With end with con filtros

Dante,

Quiero eliminar el que la macro seleccione una hoja y filtre y cambiarlo utilizando la instrucción With End with.

Te paso el código que tengo

Worksheets("Materiales").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$I").AutoFilter Field:=9, Criteria1:=Range("R1").Value
Dim PROD1 As Object
Set PROD1 = Worksheets("Materiales").Cells(2, 7).Resize _
(Worksheets("Materiales").Cells(2, 7).CurrentRegion.Columns.Rows.Count - 1)
PROD1.Select
Range(Selection, Selection.End(xlToLeft)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Semanal").Select
Range("B16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

1

1 Respuesta

3.608.900 pts. Si me amas, siempre voy a estar en tu corazón; si me...

Esta sería una forma:

Sub Copiar()
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Materiales")
    Set h2 = Sheets("Semanal")
    With h1
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("$A:$I").AutoFilter Field:=9, Criteria1:=.Range("R1").Value
        u = .Cells(Rows.Count, 7).End(xlUp).Row
        If u > 1 Then
            .Range("A2:G" & u).Copy
            h2.Range("B16").PasteSpecial Paste:=xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    MsgBox "Copiado"
End Sub

Aunque también puede quedar sin el With:

Sub Copiar()
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Materiales")
    Set h2 = Sheets("Semanal")
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h1.Range("$A:$I").AutoFilter Field:=9, Criteria1:=h1.Range("R1").Value
    u = h1.Cells(Rows.Count, 7).End(xlUp).Row
    If u > 1 Then
        h1.Range("A2:G" & u).Copy
        h2.Range("B16").PasteSpecial Paste:=xlPasteValues
    End If
    Application.CutCopyMode = False
    MsgBox "Copiado"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas