Переставить столбцы на всех листах

Question

У меня есть код, вставленный ниже, работающий для одного листа в книге, но я не могу понять, как выполнить цикл по книге, чтобы он делал это для каждого листа.

Может кто-нибудь объяснить, как использовать функцию цикла для этого кода, пожалуйста? :)

Sub Rearrange_Columns()
Dim arrColOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
arrColOrder = Array("Company", "First Name", "Last Name", "Email", "Category", "Address", "Suite or Unit?", "Suite/Unit", "City", "Province", "Postal Code", "Phone", "Fax", _
"Website", "Service Areas", "Logo", "CONCAT")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole,SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not Found Is Nothing Then
        If Found.Column <> counter Then
         Found.EntireColumn.Cut
         Columns(counter).Insert Shift:=xlToRight
         Application.CutCopyMode = False
        End If
        counter = counter + 1
     End If
Next ndx
End Sub

Answer 1

То, что вам нужно, - это просто цикл по рабочим листам и указание рабочего листа для каждого Rows, Columns, Range и т. Д.

For Each ws In ThisWorkbook.Worksheets
    ws.Rows(…) 'specify the worksheet
Next ws

Например

Option Explicit

Sub RearrangeColumnsInAllWorksheets()
    Dim arrColOrder As Variant
    arrColOrder = Array("Company", "First Name", "Last Name", "Email", "Category", "Address", "Suite or Unit?", "Suite/Unit", "City", "Province", "Postal Code", "Phone", "Fax", "Website", "Service Areas", "Logo", "CONCAT")

    Dim ndx As Long
    Dim Found As Range

    Dim Counter As Long
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop through all worksheets
        Counter = 1
        For ndx = LBound(arrColOrder) To UBound(arrColOrder)
            Set Found = ws.Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
            If Not Found Is Nothing Then
                If Found.Column <> Counter Then
                    Found.EntireColumn.Cut
                    ws.Columns(Counter).Insert Shift:=xlToRight
                    Application.CutCopyMode = False
                End If
                Counter = Counter + 1
             End If
        Next ndx
    Next ws

    Application.ScreenUpdating = True 'don't forget to turn it on again
End Sub