Excel Macro/how to write macro to copy/paste rows from Workbook with 200 sheets to Table - excel

Question

I have an Excel Workbook (named Peak) with 100 sheets (each Sheet starts with Sheet1 followed by a unique name, Sheet1AA), I want to copy one column from each Peak Sheet and paste into a new Workbook (named Table) using transpose, so the Table will have 100 rows of data from the Peak Workbook Sheets. Below is an example where two Sheets are copied and then pasted, with the second Sheet (Sheet1BB) pasted below the first Sheet (Sheet1AA) in the Table. I know I can record a macro as I do the copy/paste-transpose, but hoping there is a way to write a macro to do the copy/paste consecutively/in order from the Peak Workbook (Sheet1AA-Sheet1ZZ) to the Workbook Table to give 100 rows of data, with data from Sheet1AA the first row and Sheet1ZZ the last row in the Table.
Thank you
Windows("Peak.xlsm").Activate
Sheets("Sheet1AA").Select
Range("O6:O150").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Table.xlsm").Activate
Range("E4:AB4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows("Peak.xlsm").Activate
Sheets("Sheet1BB").Select
Range("O6:O150").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Table.xlsm").Activate
Range("E5:AB5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Answer 1

Untested:
Dim r As Long, sht As Worksheet
r = 4
For Each sht In Workbooks("Peak.xlsm").Worksheets
sht.Range("O6:O150").Copy
Workbooks("Table.xlsm").Sheets(1).Cells(r, "E").PasteSpecial Transpose:=True
r = r + 1
Next sht

Answer 2

Since OP's need to maintain pasted data ordered by parent sheet name, here follows two possible codes:
temporary helper column
this approach
inserts a (temporary) column right before column "E" where to store sheet names, while corresponding data are written from the next column to rigthwards.
sorts the pasted range on sheet names in (temporary) column "E"
deletes temporary column
Option Explicit
Sub Main()
Dim iSht As Long
Dim sht As Worksheet
With Workbooks("Table.xlsm").Worksheets(1)
.Columns("E").Insert '<--| insert temporary helper column
For Each sht In Workbooks("Peak.xlsm").Worksheets '<--| loop through sheets
sht.Range("O6:O150").Copy
.Cells(4 + iSht, "E") = sht.Name '<--| write sheet name in temporary helper column
.Cells(4 + iSht, "F").PasteSpecial Transpose:=True '<--| write data from the next colum rightwards
iSht = iSht + 1
Next sht
With .Cells(4, "E").Resize(iSht, 146) '<--| consider temporary helper column cells containing sheet names
.Sort key1:=.Cells(1, 1), order1:=xlAscending '<--| sort them
.EntireColumn.Delete '<--| remove temporary helper column
End With
End With
End Sub
array with ordered sheet names
this requires writing them down in a temporary sheet (in ThisWorkbook), sorting them and reading them back (see Function GetSortedWsNames())
Sub Main2()
Dim i As Long: i = 4
Dim wb As Workbook
Dim el As Variant
Set wb = Workbooks("Peak.xlsm")
With Workbooks("Table.xlsm").Worksheets(1)
For Each el In GetSortedWsNames(wb)
wb.Worksheets(el).Range("O6:O150").Copy
.Cells(i, "E").PasteSpecial Transpose:=True
i = i + 1
Next el
End With
End Sub
Function GetSortedWsNames(wb As Workbook) As Variant
Dim ws As Worksheet
Dim iSht As Long
Set ws = ThisWorkbook.Worksheets.Add
With wb
For iSht = 1 To .Worksheets.Count
ws.Cells(iSht, 1) = .Worksheets(iSht).Name
Next iSht
End With
With ws.Cells(1, 1).Resize(iSht - 1)
.Sort key1:=ws.Cells(1, 1), order1:=xlAscending
GetSortedWsNames = Application.Transpose(.Cells)
End With
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Function