VBA单步通过代码工作，按钮不工作

我可以单步执行宏，但按钮不能正常工作。 我要做的只是格式化工作表，以便按以下特定顺序排列列：

vCOLs = Array("Purchase Order", "Document Number", "Invoice Date", _
"Invoice Number", "Business Unit", "Object", "Subsidiary", "G/L Date", _
"Period Number", "Fiscal Year", "Supplier", "Name", _
"Supplier Name/ Explanation", "Description", "Explanation -Remark-", _
"Amount")

以下是我目前掌握的代码：

Dim a As Long, w As Long, x As Long, col As Long, lRow As Long
Dim c As Long, vCOLs As Variant
Dim vDELCOLs As Variant, vCOLNDX As Variant, N As Variant
Dim sht As Range, ACell As Range, Rng As Range
Dim wb1 As Workbook
Dim ws As Worksheet

Set wb1 = Workbooks("Sourcing KPI Spend Report Q3 2017.xlsm")
Set sht = wb1.Sheets("Spend Report").UsedRange
Set ws = ThisWorkbook.Sheets("Spend Report")

Application.ScreenUpdating = False

ws.Rows("1:6").Delete
sht.AutoFilter Field:=1, Criteria1:="="

sht.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
sht.AutoFilter
sht.AutoFilter Field:=2, Criteria1:="="
sht.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
sht.AutoFilter

vDELCOLs = Array("Account Number", "Batch Type", "Batch Number", "Doc Type", _
   "Company", "LT", "Transaction Currency", "Base Currency", "Work Order", _
      "Subledger", "Subledger Type", "Transaction Originator")

With Sheets("Spend Report")
    For a = LBound(vDELCOLs) To UBound(vDELCOLs)
        vCOLNDX = Application.Match(vDELCOLs(a), .Rows(1), 0)
            If Not IsError(vCOLNDX) Then
                .Columns(vCOLNDX).EntireColumn.Delete
            End If
    Next a
End With

ColCount = Sheets("Spend Report").Cells(1, 
Columns.Count).End(xlToLeft).Column

sht.EntireColumn.Insert (ColCount)

这就是它开始破裂的地方

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Purchase Order" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("A1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Document Number" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("B1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Invoice Date" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("C1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Invoice Number" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("D1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Business Unit" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("E1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Object" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("F1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Subsidiary" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("G1").Activate
        ws.Paste
    End If
Next


For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "G/L Date" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("H1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Period Number" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("I1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Fiscal Year" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("J1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Supplier" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("K1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Name" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("L1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Supplier Name/ Explanation" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("M1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Description" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("N1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Explanation -Remark-" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("O1").Activate
        ws.Paste
    End If
Next

For i = 35 To 1 Step -1
    If ws.Cells(1, i) = "Amount" Then
        ws.Cells(1, i).EntireColumn.Cut
        Range("P1").Activate
        ws.Paste
    End If
Next

Cells.EntireColumn.AutoFit

For i = 17 To 1 Step -1
    If Cells(1, i) = "Purchase Order" Then
        Cells(1, i).EntireColumn.Hidden = True
    End If
Next

For i = 17 To 1 Step -1
    If Cells(1, i) = "Document Number" Then
        Cells(1, i).EntireColumn.Hidden = True
    End If
Next

For i = 17 To 1 Step -1
    If Cells(1, i) = "Invoice Date" Then
        Cells(1, i).EntireColumn.Hidden = True
    End If
Next

For i = 17 To 1 Step -1
    If Cells(1, i) = "Invoice Number" Then
        Cells(1, i).EntireColumn.Hidden = True
    End If
Next

'    vCOLs = Array("Purchase Order", "Document Number", "Invoice Date", _
"Invoice Number", "Business Unit", "Object", "Subsidiary", "G/L Date", _
"Period Number", "Fiscal Year", "Supplier", "Name", _
"Supplier Name/ Explanation", "Description", "Explanation -Remark-", _
"Amount")

Application.ScreenUpdating = True

End Sub

尝试一下：

Sub tgr()

    Dim wb As Workbook
    Dim Source As Worksheet
    Dim DestWS As Worksheet
    Dim DestCell As Range
    Dim FoundHeader As Range
    Dim ColHeaders As Variant
    Dim ColHeader As Variant

    Const HeaderRow = 1     'Note this is the header row after the first 6 rows are deleted
    Const SheetName As String = "Spend Report"

    'Typically you want macros run on the active workbook
    Set wb = ActiveWorkbook

    'If this macro is not being run on the active workbook, you can specify the workbook to run it on
    'To do so, uncomment the below line and comment out the ActiveWorkbook line above
    'Set wb = Workbooks("Sourcing KPI Spend Report Q3 2017.xlsm")

    Set Source = wb.Sheets(SheetName)
    ColHeaders = Array("Purchase Order", "Document Number", "Invoice Date", _
                       "Invoice Number", "Business Unit", "Object", "Subsidiary", "G/L Date", _
                       "Period Number", "Fiscal Year", "Supplier", "Name", _
                       "Supplier Name/ Explanation", "Description", "Explanation -Remark-", _
                       "Amount")

    'Delete first 6 rows
    Source.Range("1:6").EntireRow.Delete

    'Delete rows where there are blank cells in column A or B
    Source.UsedRange.AutoFilter 1, "="
    Source.UsedRange.Offset(1).EntireRow.Delete
    Source.UsedRange.AutoFilter
    Source.UsedRange.AutoFilter 2, "="
    Source.UsedRange.Offset(1).EntireRow.Delete
    Source.UsedRange.AutoFilter

    'Create new worksheet that will contain the columns in desired order
    Set DestWS = wb.Sheets.Add(After:=Source)
    Set DestCell = DestWS.Range("A1")

    'Cut/paste the columns in the proper order to the new sheet
    For Each ColHeader In ColHeaders
        Set FoundHeader = Source.Rows(HeaderRow).Find(ColHeader, Source.Cells(HeaderRow, Source.Columns.Count), xlValues, xlWhole)
        If Not FoundHeader Is Nothing Then
            FoundHeader.EntireColumn.Cut DestCell
            Set DestCell = DestWS.Cells(1, DestWS.Columns.Count).End(xlToLeft).Offset(, 1)
        End If
    Next ColHeader

    'Delete the original which will no longer be used
    Application.DisplayAlerts = False
    Source.Delete
    Application.DisplayAlerts = True

    'Rename the destination sheet to the proper sheet name
    DestWS.Name = SheetName

End Sub

---

只是看看你的循环，而不是VBA专家，我有两个问题。1） 当您

范围（“E1”）。激活时

它如何知道哪张纸上有E1？我假设它会在运行它之前的最后一张“活动”表上尝试这样做。不确定这是否与按钮所在的位置以及您跨接按钮的时间不同。2） 为什么不使用一个循环，只在一个循环下对个别情况执行操作，而不是对我使用多个35对1的循环？@Forward Ed-我尝试将工作表标识为：工作表（“支出报告”）…范围（“A1”）。激活也尝试了：ws.Range（“A1”）。激活这两个工作表都不起作用。然而，当我删除工作表并逐步完成时。它贴在指定的范围内。泰格拉瓦塔-你很好，先生。你的代码比我的好得多，整洁得多。谢谢，我真的很感激。