VBA:重新排列列代码将列移到每张工作表的右侧

时间:2018-11-07 13:29:14

标签: excel vba excel-vba

我有这段代码可以浏览每个工作表并根据数组重新排列列。问题在于,每张纸上的代码都会使我的列从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

谢谢!

0 个答案:

没有答案