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

Question

如何从不同的工作表中复制相同的非连续单元格并逐行粘贴到一个主工作表（“sheet5”）中。

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