This code is used to rearrange some columns, but it’s not working properly?

[RagingR12]

This code is used to rearrange some columns, but it’s notworking properly?

Why is the following code working for the first worksheetbut not working for the second work sheet?

It scrambles up the first header row.

For i = 1 To ThisWorkbook.Sheets.Count
 Sheets(i).Activate
With ActiveSheet
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    arrColOrder = Array("VolgCode", "Home", "Level", "Find No.", "Item Id", "Revision", "Change", "Item Name", "Qty")
    
    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
    Application.ScreenUpdating = True
 End With
Next i

Thanks for any help.

 

[JackDanIce]

This works for me for more than 1 sheet:

Sub SortCols()

    Dim c       As Long
    Dim i       As Long
    Dim x       As Long
    Dim w       As Long
    
    Dim r       As Range
    Dim arr     As Variant
    
    arr = Split("VolgCode|Home|Level|Find No.|Item Id|Revision|Change|Item Name|Qty", "|")
    
    Application.ScreenUpdating = False
    
    For w = 1 To ThisWorkbook.sheets.Count
        i = 1
        With sheets(w)
            c = .Cells(1, .Columns.Count).End(xlToLeft).Column
            For x = LBound(arr) To UBound(arr)
                Set r = .Cells(1, 1).Resize(, c).Find(arr(x), after:=.Cells(1, 1), LookIn:=xlFormulas, searchorder:=xlByRows)
                If Not r Is Nothing Then
                    If r.Column <> i Then
                        r.EntireColumn.Cut
                        .Columns(i).Insert
                        Application.CutCopyMode = False
                        Set r = Nothing
                        i = i + 1
                    End If
                End If
            Next x
        End With
    Next w
    
    Application.ScreenUpdating = True
    
    Erase arr
End Sub

Are the search values definitely on row 1 on each sheet?