Сравнительная производительность:
All-at-once - Total Sheets: 1,001 - Time: 29.137 sec (by JvdV)
One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
Вот тесты
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
Тестовые листы (все одинаковые)
До
* * После того, как тысяча двадцать-один * * тысяча двадцать-два