Copying Worksheet Contents

[hellorich]

I have a workbook with 300 tabs. Each tab contains 2 columns in exactly the same position starting in cell A8 and ending in cell B37 (30 rows). The first column in each tab contains a list of questions and the second column contains responses to those questions consisting of text and numbers. I am trying to create a summary worksheet in the same workbook by having a macro copy the data from the second column in each worksheet and paste the results to the summary worksheet tab BUT transposed horizontally so that there will be 300 rows of data in 30 columns. The first column in each tab should be ignored as it will function as the header row only in the summary worksheet. Any ideas would be greatly appreciated.

 

[onlyadrafter]

Hello,

is this working as expected?

Sub COPY_TO_SUMMARY_SHEET()
    For MY_TABS = 2 To ActiveWorkbook.Sheets.Count
        With Sheets(MY_TABS)
            .Range("B8:B37").Copy
            Sheets("SUMMARY").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
        End With
    Next MY_TABS
End Sub

Have assumed the first tab is SUMMARY and the other 300 tabs follow after this one.

 

[Yard]

Hi, try

Option Explicit
Sub CompileAnswers()
Dim ws, wsSummary As Worksheet
Dim i As Integer, j As Integer
Const intNumQuestions As Integer = 30
Application.ScreenUpdating = False
i = 1
Set wsSummary = ThisWorkbook.Worksheets("Summary")
wsSummary.UsedRange.ClearContents
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = wsSummary.Name Then GoTo NextWs
    If i > 1 Then GoTo JustAnswers
    For j = 1 To intNumQuestions
        ws.Cells(j, 1).Copy
        wsSummary.Cells(1, j + 1).PasteSpecial xlPasteValues
    Next j
 
JustAnswers:
 
    For j = 1 To intNumQuestions
    ws.Cells(j, 2).Copy
    wsSummary.Cells(i + 1, j + 1).PasteSpecial xlPasteValues
    wsSummary.Cells(i + 1, 1) = ws.Name
    Next j
 
i = i + 1
NextWs:
Next ws
Application.ScreenUpdating = True
End Sub

edit: not quite as slick as onlyadrafter!

 

[hellorich]

Thank you very much! Will test and let you know.