多工作表数据转置至汇总表的VBA宏问题求助

Problem 1: Runtime Error 424 (Object Required) #

• Root causes:
  • raw is declared as a Worksheet but assigned to an array of sheet names (strings), causing a type mismatch.
  • Variables ns and og are undefined and unassigned.
  • Calling Activate on an array (not an object) is invalid.

Problem 2: Only Processes Up to 27 Columns #

• Root causes:
  • WorksheetFunction.CountA stops counting at empty cells, potentially missing your full 96 columns.
  • The code doesn’t loop through all 5 source sheets—it only attempts to process one sheet incorrectly.
  • No logic to append transposed data from each sheet to the total sheet (overwrites instead of adding).

Corrected VBA Code #

Sub transpose_to_total()
    Dim rawSheets As Variant
    Dim raw As Worksheet
    Dim tot As Worksheet
    Dim count_col As Long
    Dim count_row As Long
    Dim nextRow As Long
    Dim i As Long, j As Long
    
    ' Define array of source sheet names
    rawSheets = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
    ' Set reference to total sheet (using index 9)
    Set tot = ThisWorkbook.Sheets(9)
    
    ' Clear total sheet content
    tot.Cells.ClearContents
    nextRow = 1 ' Starting row for first transposed sheet
    
    ' Loop through each source sheet
    For Each sheetName In rawSheets
        Set raw = ThisWorkbook.Sheets(sheetName)
        
        ' Get actual used range dimensions (avoids issues with empty cells)
        count_row = raw.UsedRange.Rows.Count
        count_col = raw.UsedRange.Columns.Count
        
        ' Transpose data and paste to total sheet
        For i = 1 To count_row
            For j = 1 To count_col
                tot.Cells(nextRow + j - 1, i) = raw.Cells(i, j).Value
            Next j
        Next i
        
        ' Move nextRow down by the number of columns (since we transposed rows to columns)
        nextRow = nextRow + count_col
    Next sheetName
    
    ' Optional: Activate total sheet at the end
    tot.Activate
End Sub

Key Improvements Explained #

• Fixed Type Mismatch: Renamed raw to rawSheets (a variant array) to hold sheet names, then loop through each name to assign a valid Worksheet object.
• Reliable Range Detection: Used UsedRange instead of CountA to capture full data dimensions, even if empty cells exist.
• Loop Through All Sheets: Added a For Each loop to process every source sheet, appending transposed data to the total sheet using nextRow to track position.
• Defined Missing Variables: Added declarations for all used variables to avoid implicit errors.
• Proper Transposition: Corrected cell indexing to swap rows and columns correctly.

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