Sub CopyNonContiguousSelections() 'How to copy non contiguous cell ranges
Set cellranges = Application.Selection 'Sets the Selected Cell as the cell range
Set ThisRng = Application.InputBox("Select a destination cell", "Where to paste slections?", Type:=8)
For Each cellrange In cellranges.Areas
    cellrange.Copy ThisRng.Offset(i)
    i = i + cellrange.Rows.CountLarge
Next cellrange
End Sub

'https://www.get-digital-help.com/2018/05/29/how-to-copy-non-contiguous-cell-ranges/