你可以尝试这样的东西：

Sub test()
Dim targetWks As Variant
Dim wk As Worksheet
Dim wkDest As Worksheet
Dim i As Long
Dim LR As Long
Dim rng As Range

targetWk = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
Set wkDest = ThisWorkbook.Worksheets("Final Sheet") 'final sheet to paste data

For i = LBound(targetWk) To UBound(targetWk)
    Set wk = targetWk(i)
    '(27 rows of data 96 cols for each sheet)
    Set rng = wk.Range("A1").CurrentRegion.Cells(1, 1).Resize(27, 96)
    With wkDest
        LR = .Range("A" & .Rows.Count).End(xlUp).Row 'last non blank row
    End With
    
    'paste 1 row below LR
    rng.Copy wkDest.Range("A" & (LR + 1))
    Set rng = Nothing
    Set wk = Nothing
Next i

Erase targetWk
Set wkDest = Nothing

End Sub

这段代码假设要复制的第一列是A，第一行是1，因此第一个数据单元格是A1。此外，它假定您要将其粘贴到最终工作表的A列上。如果需要，可以更改这些参数，但代码将始终从左上角的起始单元格（代码中的A1）复制27行数据和96列数据

复制转置值

Option Explicit

Sub CopyTransposeValues()

    ' Define constants.
    Const DST_SHEET_ID As Variant = 9
    Dim sNames():
    sNames = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Using a sheets collection, reference all the source worksheets.
    Dim swss As Sheets: Set swss = wb.Worksheets(sNames)
    
    ' Reference the first destination cell.
    Dim dws As Worksheet: Set dws = wb.Worksheets(DST_SHEET_ID)
    Dim dfCell As Range: Set dfCell = dws.Range("A1")
    dws.UsedRange.Clear
    
    ' Declare new variables to be used in the For Each...Next loop.
    Dim sws As Worksheet, srg As Range, drg As Range, sData, dData
    Dim rCount As Long, cCount As Long, r As Long, c As Long
    
    ' Loop over the (source) worksheets in the sheets collection.
    For Each sws In swss
        ' Write the values from the source range to the source array.
        Set srg = sws.Range("A1").CurrentRegion
        rCount = srg.Rows.Count
        cCount = srg.Columns.Count
        sData = srg.Value
        ' Write the transposed values from the source to the destination array.
        ReDim dData(1 To cCount, 1 To rCount)
        For r = 1 To rCount
            For c = 1 To cCount
                dData(c, r) = sData(r, c)
            Next c
        Next r
        ' Write the transposed values to the destination range.
        dfCell.Resize(cCount, rCount).Value = dData
        ' Reference the next first destination cell.
        Set dfCell = dfCell.Offset(cCount)
    Next sws

    MsgBox "Values copy-transposed.", vbInformation

End Sub