macro to copy multiple cell ranges and paste in a row on another sheet

Question

I recorded a macro, What I'm trying to obtain is creating a code that will copy the following range in the code on each worksheet and paste it in rows underneath each other on sheet "Master".

I have the following code:

Sub Macro1()
'
' Macro1 Macro
'

'
 Dim rng As Range
Sheets("AL-Jackson Hospital-Fvar").Select

Set rng = Range( _
"K50:M50,K58:M58,K59:M59,K55:M55,K12:M12,K14:M14,K24:L24,K28:L28,K29:L29,K35:L35,K62:L62,K32:L32,K30:L30,K31:L31,K63:L63,K33:L33,K34:L34,K37:L37,K40:L40,K41:L41,K42:L42,K46:L46" _
    )
rng.Select
Selection.Copy
Sheets("Master").Select
Range("B4").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst

End Sub

For example: On sheet 1, 2 ,3 Copy the following range on each sheet and paste as values in sheet Master starting in Cell B1. So sheet 1 data range should be in B1, sheet 2 data range should be in b2, and sheet 3 data range should be in b3 and etc....

Guys my workbook has over 50 sheets

Answer 1

Something like should work for you:

Sub tgr()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsDest As Worksheet
    Dim rCell As Range
    Dim aData() As Variant
    Dim sCells As String
    Dim i As Long, j As Long

    Set wb = ActiveWorkbook
    Set wsDest = wb.Sheets("Master")
    sCells = "K50:M50,K58:M58,K59:M59,K55:M55,K12:M12,K14:M14,K24:L24,K28:L28,K29:L29,K35:L35,K62:L62,K32:L32,K30:L30,K31:L31,K63:L63,K33:L33,K34:L34,K37:L37,K40:L40,K41:L41,K42:L42,K46:L46"

    ReDim aData(1 To wb.Sheets.Count - 1, 1 To wsDest.Range(sCells).Cells.Count)

    i = 0
    For Each ws In wb.Sheets
        If ws.Name <> wsDest.Name Then
            i = i + 1
            j = 0
            For Each rCell In ws.Range(sCells).Cells
                j = j + 1
                aData(i, j) = rCell.Value
            Next rCell
        End If
    Next ws

    wsDest.Range("B1").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData

End Sub

Answer 2

here's an alternative "formula" approach

other than putting in an alternative approach, it also reduces the number of iterations from (nsheets-1)*ncells (as per tigeravatar's solution) to (nsheets-1) + ncells, should it ever be a relevant issue

Option Explicit

Sub main()

    Dim ws As Worksheet
    Dim cell As Range, refCell As Range

    With ActiveWorkbook.Sheets("Master")
        For Each ws In wb.Sheets
             .Cells(.Rows.Count, 1).End(xlUp).Offset(1) = IIf(ws.Name <> .Name, ws.Name, "")
        Next ws
        Set refCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)

        For Each cell In Range("K50:M50,K58:M58,K59:M59,K55:M55,K12:M12,K14:M14,K24:L24,K28:L28,K29:L29,K35:L35,K62:L62,K32:L32,K30:L30,K31:L31,K63:L63,K33:L33,K34:L34,K37:L37,K40:L40,K41:L41,K42:L42,K46:L46")
            .Cells(refCell.Row, .Columns.Count).End(xlToLeft).Offset(, 1).Value = cell.Address ' set the reference for INDIRECT() function
        Next cell
        With .Range("B2", .Cells(refCell.Row, .Columns.Count).End(xlToLeft).Offset(-1))
            .FormulaR1C1 = "=INDIRECT(ADDRESS(ROW(INDIRECT(R" & refCell.Row & "C)),COLUMN(INDIRECT(R" & refCell.Row & "C)),,,RC1))"
            .Value = .Value
            .Offset(.Rows.Count).Resize(1).ClearContents
        End With
    End With

End Sub

it leaves the sheets name in column "A": they can be removed