Transposing all lines of data on multiple sheets into final sheet

Question

I am trying to transpose 5 sheets of data (27 rows and 96 cols for each sheet) to a final sheet, with all accumulated data.

Problem 1: My macro stops at column 27 on the first sheet. Nothing I change will make it run more of the data, even on a single sheet. Problem 2: My array gives me "Runtime Error 424"

Sub transpose_to_total()

Dim raw As Worksheet
Dim tot As Worksheet
Dim count_col As Integer
Dim count_row As Integer

Set raw = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
Set tot = ThisWorkbook.Sheets(9)

tot.Cells.ClearContents
raw.Activate

count_row = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
count_col = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlToRight)))

For i = 1 To count_row
    For j = 1 To count_col
        ns.Cells(i, j) = og.Cells(j, i).Text
    Next j
Next i

tot.Activate

What are you hoping to accomplish by assigning an array of strings to a variable of the "Worksheet" datatype? (Set raw = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")) And what is "ns" and "og", I don't see those variables declared or assigned anywhere. I would also recommend against refering to worksheets by their index as indices change when you rearrange the worksheets, referring to them by name is much safer (Worksheets("worksheetName")) — andrewb, Apr 28 '23 at 06:57
Do you want everything from sheets 4->8 on sheet 9 or are there headers you need to skip? — Notus_Panda, Apr 28 '23 at 07:34
Hi there, Yep I am looking to move all data in rows from sheets 4,5,6,7,8 to sheet 9 in columns. (Skipping column A (headers) would be amazing but not vital. — user21761326, May 01 '23 at 23:16

Foxfire And Burns And Burns · Answer 1 · 2023-05-02T08:37:22.123

You could try something like this:

Sub test()
Dim targetWk 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 = ThisWorkbook.Worksheets(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

This code assumes your first column to copy is A and your first row is 1, so first cell of data is A1. Also, it assumes you want to paste it onto column A from final sheet. Change those parameters if needed but the code will copy always 27 rows of data and 96 columns from a starting top left cell (A1 in the code)

Thank you! This is giving me: Run-time error "424": Object required Set wk = targetWk(i) — user21761326, May 01 '23 at 23:23

score 1 · Answer 2 · answered Apr 28 '23 at 10:53

Copy-Transpose Values

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

Thank you! I am getting a Runtime error '9': Subscript out of range. 'Dim swss As Sheets: Set swss = wb.Worksheets(sNames)' — user21761326, May 01 '23 at 23:29

Transposing all lines of data on multiple sheets into final sheet

2 Answers2

Copy-Transpose Values