excel - VBA：重新排列列代码在每张纸上将列向右移动

Question

我有这段代码可以查看每个工作表并根据数组重新排列列。问题是，对于每张纸，代码都会将我的列从 A1 开始移动。

例如，工作表 1 从 A1 开始，工作表 2 从 P1 开始，工作表 3 从 AE 开始，依此类推。他们都需要从A1开始。

此外，在除了第 1 页之外的每张纸上，它都会在每个标题之后添加一个空白列，这是我不想要的。

这是代码：

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
Counter = 1
Application.ScreenUpdating = False

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'loop through all worksheets
    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

谢谢！

标签： excelvba