Suprimir columnas enteras según varios valores del encabezado

Se que eres una persona muy ocupada y no quiero molestar, pero necesito tu ayuda.

¿Se puede eliminar columnas enteras según varios valores del encabezado?

¿Se puede modificar este código para que funcione con varias hojas del mismo libro activo no solo con una como está escrito el ejemplo? Seguro que tu tienes la solución o algo mejor...!

Sub Modify_Table2()
    ' Remove specific columns
    Dim HeaderRange As Range
    Set HeaderRange = ActiveSheet.Range("A2:T1")
    Dim Target As Range
    Dim Titles As Variant
    Titles = Array("TOTAL", "NOTAS", "Tools/Malware", "Labels", "Attacker Profile", "Leak Rate", "Footprint", "Target Node", "Test Time (UTC)")
    Dim c As Long
    For c = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
        If Not IsError(Application.Match(ActiveSheet.UsedRange.Columns(c).Cells(1, 1), Titles, 0)) Then
            ActiveSheet.Columns(c).EntireColumn.Delete
        End If
    Next c
End Sub
Respuesta
1

Te dejo la macro con el agregado para que puedas ejecutarla en varias hojas.

Inhabilité las líneas de 'Target' porque este código así como lo presentas va en un módulo, por lo tanto no se utiliza Target.

Sub Modify_Table2()
    ' Remove specific columns
    'Dim HeaderRange As Range
    'Set HeaderRange = ActiveSheet.Range("A1:T1")
    'Dim Target As Range
    Dim Titles As Variant, Hojas As Variant
    Dim c As Long, x As Byte
    Titles = Array("Col1", "Col3", "Col6")
    'matriz con las hojas donde se deben eliminar las col
    Hojas = Array("Hoja1", "Resumen", "Informes")
    For x = 0 To UBound(Hojas)
        Sheets(Hojas(x)).Select
        For c = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
            If Not IsError(Application.Match(ActiveSheet.UsedRange.Columns(c).Cells(1, 1), Titles, 0)) Then
                 ActiveSheet.Columns(c).EntireColumn.Delete
            End If
        Next c
    Next x
End Sub

Si la vas a ejecutar desde un evento de Hoja debieras dejarme la macro completa, si no puedes adaptar este código.

Sdos y no olvides marcar una valoración si el tema queda resuelto.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas