Cycling through multiple sheets with the same range and copying all to a new workbook

[bigbeat85]

Hi all,

I have imported a range of pdfs into excel and populates the same cells in every worksheet.
Each worksheet names starts from 'Page001' and will continue to Page055. The page numbers are odd numbers. 'Page001' 'Page003' 'Page005' and so on.

On each sheet the range copied is
" Sheets("Page019").Select
Selection.AutoFilter
Range("A9:B16").Select
Selection.Copy"
Application.WindowState = xlNormal
Workbooks.Open Filename:= _ "External sheet to copy data"
ActiveWindow.Close
Workbooks.Add

Here I wanted to add to a specific line as that is where the data entry finishes.
" Range("A552").Select"
I'm also transposing it with the below
" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True"

I can get it to work for one sheet but unsure how to cycle through multiple sheets to copy and paste the new data into the new sheet "External sheet to copy data"

It is something that should be easy. But brain fog is hitting me

 

[kevin9999]

Your code is a little unclear (e.g. you apply AutoFilter but then don't seem to use it for anything) and it would have helped to see all of your code, not just part of it. However, please try the following on a copy of your workbook. The code sits in the workbook with all the sheets to be copied to a new workbook.

Option Explicit
Sub bigbeat85()
    Dim ws As Worksheet, wsDest As Worksheet
    Workbooks.Add
    Set wsDest = ActiveSheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A9:B16").Copy wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next ws
End Sub

 

[bigbeat85]

Thank you Kevin! That worked really well! It is copying all the required data.

It should be clearer. My error.

With the range that I am copying from each sheet I am then trying to transpose as well. That is the tricky bit I am facing

 

[kevin9999]

Understood. See if this gives you what you want:

Option Explicit
Sub bigbeat85()
    Dim ws As Worksheet, wsDest As Worksheet
    Workbooks.Add
    Set wsDest = ActiveSheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A9:B16").Copy
        wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Transpose:=True
        Application.CutCopyMode = False
    Next ws
End Sub