sábado, 2 de febrero de 2019

Macro que copia y filtra el contenido pegado (Excel, VBA).

'-------------------------------
'-------------------------------
Sub FilterOM()
'Macro desarrollada por OMacias.

    Dim I As Long
    Dim xRg As Range
   
    On Error Resume Next
    Worksheets.Add Sheets(1)
    ActiveSheet.Name = "Hoja Destino"
   For I = 2 To Sheets.Count
        Set xRg = Sheets(1).UsedRange
        If I > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
        End If
        Sheets(I).Activate
        ActiveSheet.UsedRange.Copy xRg
    Next
 
   ActiveWindow.SmallScroll Down:=117
    Columns("C:C").Select
    Range("C118").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$C$1:$C$68970").AutoFilter Field:=1, Criteria1:= _
        "Oscar Macías"
    ActiveSheet.Shapes.Range(Array("11 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("10 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("9 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("8 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("7 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("6 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("5 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("4 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("3 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("2 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("1 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("14 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("13 Picture")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("12 Picture")).Select
    Selection.Delete
    Range("A429").Select
 
End Sub

'-------------------------------
'-------------------------------

No hay comentarios.:

Publicar un comentario