VBA代码无输出求助：将第二行含Total的列移至透视表末尾

Let's break down why your current code isn't producing output, then fix it step by step to meet your goal: after a paste-special operation, move any column where the second row contains "Total" to the end of your table.

First, Let's Spot the Issues in Your Snippet #

Your code has several gaps that are preventing it from working:

1. Incomplete code: PRTSLastRow... cuts off, so the core logic for checking columns and moving them is missing entirely.
2. Unassigned variable: You declared Total As String but never set its value to "Total"—so your check for the word will never trigger.
3. No loop logic: To scan every cell in the second row, you need a loop to iterate through columns, which isn't present here.
4. Dependence on active workbook: Using ActiveWorkbook can lead to errors if the wrong workbook is active when the macro runs.
5. Forward-traversal risk: If you do add a loop, traversing columns from left to right will break your index after moving a column (since shifting columns changes their positions).

Fixed & Complete VBA Code #

Here's a fully functional version with explanations of key changes:

Sub MoveTotalColumnsToEnd()
    Dim PRTSLastCol As Long
    Dim Total As String
    Dim j As Integer
    Dim ws As Worksheet
    Dim targetCol As Range
    
    ' Set the keyword we're looking for
    Total = "Total"
    ' Bind to your target worksheet directly (avoids active workbook/sheet bugs)
    Set ws = ThisWorkbook.Worksheets("PRTSCarrierCount")
    
    ' --------------------------
    ' Add your paste-special logic here (adjust range/paste type as needed)
    ' Example: Paste values to the starting range of your table
    ' ws.Range("A1").PasteSpecial Paste:=xlPasteValues
    ' --------------------------
    
    ' Get the last used column in the SECOND row (since that's where we check for "Total")
    PRTSLastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    
    ' Traverse columns FROM RIGHT TO LEFT (prevents index issues after moving columns)
    For j = PRTSLastCol To 1 Step -1
        ' Check if the cell contains "Total" (vbTextCompare makes it case-insensitive)
        If InStr(1, ws.Cells(2, j).Value, Total, vbTextCompare) > 0 Then
            ' Define the column to move
            Set targetCol = ws.Columns(j)
            ' Cut and insert the column to the end of the table
            targetCol.Cut
            ws.Columns(PRTSLastCol + 1).Insert Shift:=xlToRight
            ' Update the last column index (we just added a new column to the end)
            PRTSLastCol = PRTSLastCol + 1
        End If
    Next j
    
    ' Clean up the clipboard to avoid accidental pastes later
    Application.CutCopyMode = False
End Sub

Key Fixes Explained #

• Worksheet binding: Using ThisWorkbook.Worksheets("PRTSCarrierCount") ensures we're always working on the correct sheet, regardless of what's active.
• Right-to-left loop: Moving columns shifts the positions of columns to the right, so looping backward prevents us from skipping columns or processing the same column twice.
• Explicit keyword assignment: Setting Total = "Total" gives your check a value to look for.
• Flexible matching: InStr with vbTextCompare lets you match "Total", "total", or "TOTAL"—use ws.Cells(2, j).Value = Total instead if you need an exact case-sensitive match.

Quick Troubleshooting Checklist #

If the code still doesn't run:

1. Enable macros: Make sure your workbook has macros enabled (go to File > Options > Trust Center > Trust Center Settings > Macro Settings).
2. Verify paste-special: Add a MsgBox "Paste completed" right after your paste-special line to confirm that step is executing properly.
3. Check sheet name: Double-check that your worksheet is actually named PRTSCarrierCount (no typos or extra spaces).
4. Validate cell content: Ensure the "Total" text is in the second row (not hidden, not part of a formula result that doesn't display the word directly).

内容的提问来源于stack exchange，提问作者HobbyCoder