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/