Rearrange columns on all worksheets

2019-08-28 21:28发布

I've got the code pasted below working for one worksheet in the workbook but I can't figure out how to loop it through the workbook so it does it to every sheet.

Can someone explain how to use to loop function for this code please? :)

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

1条回答
别忘想泡老子
2楼-- · 2019-08-28 22:10

What you need is just a loop through the worksheets, and specify the worksheet for each Rows, Columns, Range, etc

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

For Example

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
查看更多
登录 后发表回答