Excelで飛び飛びのセルをコピペするＶＢＡコード

Excelで離れた飛び飛びのセルをコピペするVBAコード。
https://excel-windows.hateblo.jp/entry/excel-skip-cell-copy-paste

■値貼り付け
Sub CopyDiagonalCells()
Dim cell As Range
Dim baseRow As Long
Dim baseCol As Long
Dim pasteStart As Range

Set pasteStart = Application.InputBox("貼り付け開始セルを選んでください", Type:=8)

baseRow = Selection.Areas(1).Cells(1).Row
baseCol = Selection.Areas(1).Cells(1).Column

For Each cell In Selection
    pasteStart.Offset(cell.Row - baseRow, cell.Column - baseCol).Value = cell.Value
Next cell

MsgBox "位置関係を保って貼り付けました！"

End Sub

■すべて貼り付け
Sub CopyDiagonalCellsFullCopy()
Dim cell As Range
Dim baseRow As Long
Dim baseCol As Long
Dim pasteStart As Range
Dim wsSource As Worksheet
Dim wsDest As Worksheet

On Error Resume Next
Set pasteStart = Application.InputBox("貼り付け開始セルを選んでください", Type:=8)
On Error GoTo 0
If pasteStart Is Nothing Then Exit Sub

Set wsSource = ActiveSheet
Set wsDest = pasteStart.Worksheet

baseRow = Selection.Areas(1).Cells(1).Row
baseCol = Selection.Areas(1).Cells(1).Column

For Each cell In Selection
    Dim rOffset As Long
    Dim cOffset As Long
    rOffset = cell.Row - baseRow
    cOffset = cell.Column - baseCol

    cell.Copy
    wsDest.Cells(pasteStart.Row + rOffset, pasteStart.Column + cOffset).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Next cell

Application.CutCopyMode = False
MsgBox "値・書式・罫線などをすべて同じ形で貼り付けました！"

End Sub