将不同工作表中相同的非连续单元格复制并粘贴到母版纸上

Question

how to copy same non contiguous cell from different sheets and paste in one master sheets ("sheet5") row by row.

Sub test()

    Dim cel As Range, pasteRange As Range

    Set pasteRange = ThisWorkbook.Sheets("Sheet5").Range("A2")

    For i=1 to 4
        For Each cel In ThisWorkbook.Sheets(i).Range("A2, B4, D5, E1, F3")
            pasteRange.Value = cel.Value
            Set pasteRange = pasteRange.Offset(0, 1)
        Next
    Next

End Sub

Answer 1

Dim cel As Range, pasteRange As Range
Dim sht As Worksheet

' Do not use 'ThisWorkbook' - what is the macro us ran from another one?
' Use 'ActiveWorkbook' instead or specify its name
Set pasteRange = ActiveWorkbook.Sheets("Sheet5").Range("A2")

'
For Each sht In Sheets
    If sht.name <> "Sheet5" Then
        For Each cel In sht.Range("A2, B4, D5, E1, F3")
            pasteRange.Value = cel.Value
            Set pasteRange = pasteRange.Offset(0, 1)
        Next
    End If
Next