VBA脚本不应该重新排序列

Question

我有这个vba脚本并且它没有正确地重新排序列（我有一个相同的脚本用于不同的工作表，它按预期工作）。有人可以看看我做错了吗？

 Sub CopiesandMovesData()


Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet

Dim targetBook As Workbook
Set targetBook = Application.Workbooks.Add

Dim targetSheet As Worksheet
Set targetSheet = targetBook.Worksheets(1)

With sourceSheet.Range("D:D,C:C,E:E,AL:AL,F:F,B:B,R:R,AI:AI,AJ:AJ,X:X,V:V,AK:AK,AC:AC,AD:AD,AE:AE,AF:AF,AG:AG")
    .Copy targetSheet.Range("A1")
End With

Dim headings() As Variant
headings = Array("Last Name", "First Name", "DOB", "Age", "Country of Birth", "Number", "Gender", "Program Name", "Program Type", "Discharge Date", "Admission Date", "Type of Discharge", "Address", "City", "State", "Zip Code", "Phone Number")

With targetSheet.Range("A1:Q1")
    .Value = headings
    With .Font
        .Bold = True
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10053222
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    .EntireColumn.AutoFit
End With

Dim ColumnOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
    ColumnOrder = Array("Last Name", "First Name", "DOB", "Age", "Country of Birth", "Number", "Gender", "Program Name", "Program Type", "Admission Date", "Discharge Date", "Type of Discharge", "Address", "City", "State", "Code", "Phone Number")
counter = 1

Application.ScreenUpdating = False

For ndx = LBound(ColumnOrder) To UBound(ColumnOrder)
    Set Found = Rows("1:1").Find(ColumnOrder(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

'this is where the file will be saved and you need to change the file name for each month
**TAKEN OUT FOR PRIVACY

End Sub

问题发生在昏暗的ColumnOrder作为变体行，我似乎无法弄清楚如何使其工作，因为没有抛出错误来调试它。列被复制并格式化正确 - 但重新排序没有发生。