如何编写VBA代码以删除工作簿中所有工作表的特定列？

Question

I am using Excel 2016 and I am new to VBA. I need to write the VBA code to delete specific columns for all worksheets in an Excel workbook.

Let us assume the columns that I need to delete are columns B, D, G, H, AM, AZ for all worksheets.

How can I achieve this?

Answer 1

Try this:

Sub DeleteCols()
    Dim sh As Worksheet
    'as mentioned in comments by FunThomas, deleting should be done "backwards", i.e. for right to left
    For Each sh In Worksheets
        sh.Columns("AZ").Delete
        sh.Columns("AM").Delete
        sh.Columns("H").Delete
        sh.Columns("G").Delete
        sh.Columns("D").Delete
        sh.Columns("B").Delete
    Next
End Sub

Alternatively, you could use:

Sub ClearCols()
    Dim sh As Worksheet
    For Each sh In Worksheets
        sh.Columns("B").Clear
        sh.Columns("D").Clear
        sh.Columns("G").Clear
        sh.Columns("H").Clear
        sh.Columns("AM").Clear
        sh.Columns("AZ").Clear
    Next
End Sub

Another way is (suggested by @Peh):

sh.Range("B:B,D:D,G:H,AM:AM,AZ:AZ").Delete

which should be faster on many columns (you can use Clear method analogically).

Answer 2

Approach via array and deleting "backwards"

Sub DeleteCols() 
    Dim sh As Worksheet 
    Dim arr as Variant
    arr = Array("AZ", "AM", "H", "G", "D", "B")
    For Each sh In Worksheets 
        For Each element in arr
            sh.Columns(element).Delete
        Next
    Next 
End Sub

Answer 3

some small adjustment I would make to above answers:

Try deleting all at once like this:

Sub DEL()

Dim SHT As Worksheet
For Each SHT In Worksheets
    SHT.Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").EntireColumn.Delete
Next SHT

End Sub

Edit: I see my above suggestion is already implemented in the answer so I'll add another option you can do this without any loop (should be the faster way doing this):

Sheets.Select 'Selects all sheets at once
Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").Select 'Select all the appropriate columns you want to delete at once
Selection.Delete Shift:=xlToLeft 'Deletes all columns on all sheets at once

You'll be left with a selection of sheets and columns you'll have to cancel out from.

Answer 4

Comparative performance:

All-at-once - Total Sheets: 1,001 - Time: 29.137 sec (by JvdV)
One-by-one  - Total Sheets: 1,001 - Time: 72.164 sec

Here are the tests

---

Option Explicit

Public Sub DeleteColumns()
    Dim thisWs As Worksheet, thisCell As Range, t As Double, msg As String

    t = Timer
    Application.ScreenUpdating = False
    Set thisWs = ActiveSheet
    Set thisCell = ActiveCell

        ThisWorkbook.Worksheets.Select      'Selects all sheets at once

        Range("B1, D1, G1:H1, AM1, AZ1").EntireColumn.Select  'All columns on all sheets

        Selection.Delete Shift:=xlToLeft    'Deletes all columns on all sheets at once

    Cells(1).Select     'Selects A1 on all sheets
    thisWs.Select
    thisCell.Activate   'Activates initial range
    Application.ScreenUpdating = True

    msg = "All-at-once - Total Sheets: " & Format(Sheets.Count, "#,###")
    Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
    'All-at-once - Total Sheets:   101 - Time:  2.469 sec
    'All-at-once - Total Sheets:   501 - Time: 13.484 sec
    'All-at-once - Total Sheets: 1,001 - Time: 29.137 sec
End Sub

---

Sub DeleteCols()
    Dim sh As Worksheet, t As Double, msg As String

    t = Timer
    For Each sh In Worksheets
        sh.Columns("AZ").Delete
        sh.Columns("AM").Delete
        sh.Columns("H").Delete
        sh.Columns("G").Delete
        sh.Columns("D").Delete
        sh.Columns("B").Delete
    Next

    msg = "One-by-one - Total Sheets: " & Format(Sheets.Count, "#,###")
    Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
    'One-by-one - Total Sheets:   101 - Time:  3.609 sec
    'One-by-one - Total Sheets:   501 - Time: 26.633 sec
    'One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
End Sub

---

Public Sub MakeWS()
    Dim i As Long

    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets
        For i = .Count To 1000
            .Item(1).Copy After:=.Item(i)
            ActiveSheet.Name = i + 1
        Next
    End With
    Application.ScreenUpdating = True
End Sub

---

Test sheets (all the same)

Before

After