Trying to copy a certain range from several worksheets and paste into one worksheet as transposed, with each column in one line

1
votes

Trying to copy the same range from all worksheets, and paste transposed into one worksheet. I want to get one line for each column in the destination worksheet. What I have tried so far looks like this:

Sub contracts()
Dim sh As Worksheet
Dim wb As Workbook
Dim DestSh As Worksheet
Dim DestShLastRow As Long
Dim i As Integer
Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    Set DestSh = wb.Sheets("Total table")
    DestShLastRow = DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Offset(1).Row
    i = 1
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Name = "Total table" Then Exit Sub
        sh.Range("h3:h14").Copy
        DestSh.Range ("a" & i)
        .PasteSpecial xlPasteValues
        .PasteSpecial Transpose = True
        Application.CutCopyMode = False
        End With
    i = i + 1
    Next
Application.ScreenUpdating = True 
End Sub

When I run this code, I get an

1004-error, saying that "PasteSpecial method of Range class failed.

Anyone who has any advice on how to solve this problem?

1
excelvba
I think you forgot the With in the code snippet (probably just a typo here). – BigBen
That's right, just a typo. – ednit
I would replace If sh.Name = "Total table" Then Exit Sub with If sh.Name = "Total table" Then Exit For... If the sheet in discussion is not the last one, the code stops when it is reached. – FaneDuru
I would also remove the line .PasteSpecial Transpose = True and move Transpose above, resulting: .PasteSpecial xlPasteValues, Transpose = True. Of course, after adding With in front of DestSh.Range ("a" & i)... – FaneDuru
You can also avoid using the Clipboard bay using an array: Dim arr As Variant at the declarations area, then arr = sh.Range("h3:h14").Value followed by .Resize(ubound(arr,2), 1).Value = WorksheetFunction.Transpose(arr) in the With ... End With area. – FaneDuru

1 Answers

0
votes

Try changing your code, in the iteration part, in this way:

Dim arr As Variant
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name = "Total table" Then Exit For
    arr = sh.Range("h3:h14").Value
    DestSh.Range("a" & i).Resize(, UBound(arr, 1)).Value = _
                             WorksheetFunction.Transpose(arr)
    i = i + 1
 Next