選択範囲を回転するマクロ

Sub 回転して貼り付け()
    Dim words
    Dim prompt As String
    Dim res As Long, pat As Long
    Dim col0 As Long, col1 As Long, row0 As Long, row1 As Long
    Dim c As Long, r As Long, this_row As Long, this_col As Long
    '選択範囲を取得
    With Selection
        col0 = .Column
        col1 = col0 + .Columns.Count - 1
        row0 = .Row
        row1 = row0 + .Rows.Count - 1
    End With
    If col1 = col0 And row1 = row0 Then
        res = MsgBox("範囲を選択してから実行してください。", vbOKOnly)
        Exit Sub
    End If
    '角度を選択
    words = Array("右90度回転", "左90度回転", "180度回転")
    prompt = "はい:" & words(0) & _
        "、いいえ:" & words(1) & _
        "、キャンセル:" & words(2)
    res = MsgBox(prompt, vbYesNoCancel)
    If res = vbYes Then
        pat = 0
    ElseIf res = vbNo Then
        pat = 1
    ElseIf res = vbCancel Then
        pat = 2
    End If
    '確認
    prompt = words(pat) & "を実行します。※選択範囲の2行下から貼り付け。"
    res = MsgBox(prompt, vbOKCancel)
    If res <> vbOK Then Exit Sub
    'コピー＆ペースト
    For c = 0 To col1 - col0
        For r = 0 To row1 - row0
            Cells(row0 + r, col0 + c).Copy
            If pat = 0 Then '右90度
                this_row = row1 + 2 + c
                this_col = col0 + row1 - row0 - r
            ElseIf pat = 1 Then '左90度
                this_row = row1 + 2 + col1 - col0 - c
                this_col = row0 + r
            ElseIf pat = 2 Then '180度
                this_row = row1 * 2 - row0 + 2 - r
                this_col = col1 - c
            End If
            ActiveSheet.Paste Cells(this_row, this_col)
        Next r
    Next c
End Sub