Macros Copying & Transposing Specific Cells Across Multiple Sheets into Summary Sheet

[ExcelMasterWannaBe4]

I'm trying to build a macro to pull/copy the same specific cell ranges across multiple worksheets onto a summary sheet. Apologies for my incompetence but I'm new to VBA and on a short timeline so any help is appreciated. I have one workbook with ~200 identical worksheets (all with different names) and need to copy and transpose (data is kicked out of system in columns but need to convert to rows) 8 ranges ("E21:E24"), ("N42:N45"), ("AD42:AD45"), ("N21:N24"), ("S21:S24"), ("I21:I24"), ("I42:I45"), ("I63:I66") from each worksheet onto a summary page across 4 columns with the same category rows repeating going down (see below). Tried a bunch of solutions with looping but can't get it to work. Also, if possible to input the worksheet name at the beginning of each array.

[TABLE="class: cms_table, width: 389"]
<tbody>[TR]
[TD][TABLE="class: cms_table, width: 389"]
<tbody>[TR]
[TD][/TD]
[TD]F1Q15[/TD]
[TD]F2Q15[/TD]
[TD]F3Q15[/TD]
[TD]F4Q15[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3/31/2015[/TD]
[TD]6/30/2015[/TD]
[TD]9/30/2015[/TD]
[TD]12/31/2015[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SHEET #1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ops Days[/TD]
[TD]63.5[/TD]
[TD]64.5[/TD]
[TD]65.0[/TD]
[TD]65.0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Revenue[/TD]
[TD]3,266.5[/TD]
[TD]3,334.5[/TD]
[TD]3,875.7[/TD]
[TD]3,646.0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Membership[/TD]
[TD]243,478.0[/TD]
[TD]249,269.0[/TD]
[TD]253,538.0[/TD]
[TD]256,872.0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PMPM[/TD]
[TD]13.5[/TD]
[TD]14.1[/TD]
[TD]9.5[/TD]
[TD]-[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]COGs[/TD]
[TD]2,577.0[/TD]
[TD]2,722.9[/TD]
[TD]2,867.4[/TD]
[TD]2,757.7[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Gross Trips[/TD]
[TD]1,528.8[/TD]
[TD]1,542.1[/TD]
[TD]1,623.2[/TD]
[TD]1,633.4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Verified Trips[/TD]
[TD]1,117.3[/TD]
[TD]1,160.7[/TD]
[TD]1,218.6[/TD]
[TD]1,194.5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Gross Profit[/TD]
[TD]689.5[/TD]
[TD]611.6[/TD]
[TD]1,008.3[/TD]
[TD]888.3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SHEET #2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ops Days[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Revenue[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Membership[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PMPM[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]COGs[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Gross Trips[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Verified Trips[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Gross Profit[/TD]
[/TR]
</tbody>[/TABLE]

[/TD]
[/TR]
</tbody>[/TABLE]

 

[My Aswer Is This]

Received your Private Message. Have looked at your post but this may be more difficult then I'm able to accomplish.

I'm sure someone else here at Mr. Excel will be able to help you.

 

[ExcelMasterWannaBe4]

Thanks, it has proved to be more difficult than I expected as well.

 

[My Aswer Is This]

I can assure you there is someone on this forum who could provide a answer. Surprising how some times 5 people will come up with answers to the same post but then other times no one provides an answer.

 

[Fluff]

A somewhat clunky approach, but try

Sub copyTranspose()

    Dim DSht As Worksheet
    Dim Ws As Worksheet
    Dim Arr As Variant
    
    Application.ScreenUpdating = False
    
    Arr = Array("Ops Days", "", "Revenue", "", "Membership", "", "PMPM", "", "COGs", "", "Gross Trips", "", "Verified Trips", "", "Gross Profit")
    Set DSht = Sheets("[COLOR=#0000ff]Data[/COLOR]")
    For Each Ws In Worksheets
        If Not Ws.Name = "[COLOR=#0000ff]Data[/COLOR]" Then
            With DSht.Range("A" & DSht.Range("B" & Rows.Count).End(xlUp).Offset(2).Row)
                .Value = Ws.Name
                .Offset(2).Resize(15).Value = Application.Transpose(Arr)
                Ws.Range("E21:E24").Copy
                .Offset(2, 1).PasteSpecial xlValues, , , True
                Ws.Range("N42:N45").Copy
                .Offset(4, 1).PasteSpecial xlValues, , , True
                Ws.Range("AD42:AD45").Copy
                .Offset(6, 1).PasteSpecial xlValues, , , True
                Ws.Range("E21:E24").Copy
                .Offset(8, 1).PasteSpecial xlValues, , , True
            End With
        End If
    Next Ws

    Application.CutCopyMode = False

End Sub

You'll need to change the 2 values in blue to match your destination sheet name.
I've done the first 4 ranges, so you'll need to do the rest in a similar manner.

 

[Fluff]

If the ranges you're copying are values, rather than formulae, this should be a better way

Sub copyTranspose()

    Dim DSht As Worksheet
    Dim Ws As Worksheet
    Dim Arr As Variant
    
    Application.ScreenUpdating = False
    
    Arr = Array("Ops Days", "", "Revenue", "", "Membership", "", "PMPM", "", "COGs", "", "Gross Trips", "", "Verified Trips", "", "Gross Profit")
    Set DSht = Sheets("Data")
    For Each Ws In Worksheets
        If Not Ws.Name = "Data" Then
            With DSht.Range("A" & DSht.Range("B" & Rows.Count).End(xlUp).Offset(2).Row)
                .Value = Ws.Name
                .Offset(2).Resize(15).Value = Application.Transpose(Arr)
                .Offset(2, 1).Resize(, 4).Value = Application.Transpose(Ws.Range("E21:E24"))
                .Offset(4, 1).Resize(, 4).Value = Application.Transpose(Ws.Range("N42:N45"))
                .Offset(6, 1).Resize(, 4).Value = Application.Transpose(Ws.Range("AD42:AD45"))
                .Offset(8, 1).Resize(, 4).Value = Application.Transpose(Ws.Range("E21:E24"))
            End With
        End If
    Next Ws

End Sub

 

[ExcelMasterWannaBe4]

Thank you Fluff!!

 

[Fluff]

Your welcome

 

[My Aswer Is This]

See I got you a answer. I maybe could have come up with a answer but I was tired and knew there is always those out there who will jump in with answers.

Thank you Fluff!!