Option Explicit
Public Sub ボックス転置()
    Dim ws As Worksheet
    Dim rg As Range
    Dim maxrow As Long
    Dim maxcol As Long
    Dim rowb As Long
    Dim colb As Long
    Dim arr1 As Variant
    Dim arr2 As Variant
    Dim wrow As Long
    Dim wcol As Long
    Set ws = ActiveSheet
    Set rg = ws.Range("A1").CurrentRegion
    maxrow = rg.Rows.count
    maxcol = rg.Columns.count
    If maxrow Mod 4 <> 0 Then
        MsgBox ("行数が４の倍数でない")
        Exit Sub
    End If
    If maxcol Mod 4 <> 0 Then
        MsgBox ("列数が４の倍数でない")
        Exit Sub
    End If
    'セルをarr1に転送
    arr1 = rg.Value
    ReDim arr2(1 To maxcol, 1 To maxrow)
    'arr1からarr2へ転送
    For rowb = 1 To maxrow \ 4
        For colb = 1 To maxcol \ 4
            Call arr_move(rowb, colb, arr1, arr2)
        Next
    Next
    '罫線を消す
    rg.Borders.LineStyle = xlLineStyleNone
    'シートクリア
    ws.Cells.ClearContents
    '配列2をセルへ転送
    ws.Range("A1").Resize(maxcol, maxrow).Value = arr2
    '罫線を引く
    With ws.Range("A1").Resize(maxcol, maxrow).Borders
        .LineStyle = True
        .Weight = xlThin        '細線
    End With
    For wrow = 1 To maxcol Step 4
        For wcol = 1 To maxrow Step 4
            ws.Range(ws.Cells(wrow, wcol), ws.Cells(wrow, wcol + 3)).Borders.LineStyle = xlLineStyleNone
            ws.Range(ws.Cells(wrow, wcol), ws.Cells(wrow + 3, wcol + 3)).BorderAround True, xlMedium    '太線
        Next
    Next
End Sub
'ブロック単位でarr1からarr2へ転送
Private Sub arr_move(ByVal rowb As Long, ByVal colb As Long, ByRef arr1 As Variant, ByRef arr2 As Variant)
    Dim row1 As Long
    Dim row2 As Long
    Dim col1 As Long
    Dim col2 As Long
    Dim r As Long
    Dim c As Long
    Dim temp As Variant
    For r = 1 To 4
        For c = 1 To 4
            row1 = (rowb - 1) * 4 + r
            col1 = (colb - 1) * 4 + c
            row2 = (colb - 1) * 4 + r
            col2 = (rowb - 1) * 4 + c
            arr2(row2, col2) = arr1(row1, col1)
        Next
    Next
End Sub
 

T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg44Oc44OD44Kv44K56Lui572uKCkKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIERpbSByZyBBcyBSYW5nZQogICAgRGltIG1heHJvdyBBcyBMb25nCiAgICBEaW0gbWF4Y29sIEFzIExvbmcKICAgIERpbSByb3diIEFzIExvbmcKICAgIERpbSBjb2xiIEFzIExvbmcKICAgIERpbSBhcnIxIEFzIFZhcmlhbnQKICAgIERpbSBhcnIyIEFzIFZhcmlhbnQKICAgIERpbSB3cm93IEFzIExvbmcKICAgIERpbSB3Y29sIEFzIExvbmcKICAgIFNldCB3cyA9IEFjdGl2ZVNoZWV0CiAgICBTZXQgcmcgPSB3cy5SYW5nZSgiQTEiKS5DdXJyZW50UmVnaW9uCiAgICBtYXhyb3cgPSByZy5Sb3dzLmNvdW50CiAgICBtYXhjb2wgPSByZy5Db2x1bW5zLmNvdW50CiAgICBJZiBtYXhyb3cgTW9kIDQgPD4gMCBUaGVuCiAgICAgICAgTXNnQm94ICgi6KGM5pWw44GM77yU44Gu5YCN5pWw44Gn44Gq44GEIikKICAgICAgICBFeGl0IFN1YgogICAgRW5kIElmCiAgICBJZiBtYXhjb2wgTW9kIDQgPD4gMCBUaGVuCiAgICAgICAgTXNnQm94ICgi5YiX5pWw44GM77yU44Gu5YCN5pWw44Gn44Gq44GEIikKICAgICAgICBFeGl0IFN1YgogICAgRW5kIElmCiAgICAn44K744Or44KSYXJyMeOBq+i7oumAgQogICAgYXJyMSA9IHJnLlZhbHVlCiAgICBSZURpbSBhcnIyKDEgVG8gbWF4Y29sLCAxIFRvIG1heHJvdykKICAgICdhcnIx44GL44KJYXJyMuOBuOi7oumAgQogICAgRm9yIHJvd2IgPSAxIFRvIG1heHJvdyBcIDQKICAgICAgICBGb3IgY29sYiA9IDEgVG8gbWF4Y29sIFwgNAogICAgICAgICAgICBDYWxsIGFycl9tb3ZlKHJvd2IsIGNvbGIsIGFycjEsIGFycjIpCiAgICAgICAgTmV4dAogICAgTmV4dAogICAgJ+e9q+e3muOCkua2iOOBmQogICAgcmcuQm9yZGVycy5MaW5lU3R5bGUgPSB4bExpbmVTdHlsZU5vbmUKICAgICfjgrfjg7zjg4jjgq/jg6rjgqIKICAgIHdzLkNlbGxzLkNsZWFyQ29udGVudHMKICAgICfphY3liJcy44KS44K744Or44G46Lui6YCBCiAgICB3cy5SYW5nZSgiQTEiKS5SZXNpemUobWF4Y29sLCBtYXhyb3cpLlZhbHVlID0gYXJyMgogICAgJ+e9q+e3muOCkuW8leOBjwogICAgV2l0aCB3cy5SYW5nZSgiQTEiKS5SZXNpemUobWF4Y29sLCBtYXhyb3cpLkJvcmRlcnMKICAgICAgICAuTGluZVN0eWxlID0gVHJ1ZQogICAgICAgIC5XZWlnaHQgPSB4bFRoaW4gICAgICAgICfntLDnt5oKICAgIEVuZCBXaXRoCiAgICBGb3Igd3JvdyA9IDEgVG8gbWF4Y29sIFN0ZXAgNAogICAgICAgIEZvciB3Y29sID0gMSBUbyBtYXhyb3cgU3RlcCA0CiAgICAgICAgICAgIHdzLlJhbmdlKHdzLkNlbGxzKHdyb3csIHdjb2wpLCB3cy5DZWxscyh3cm93LCB3Y29sICsgMykpLkJvcmRlcnMuTGluZVN0eWxlID0geGxMaW5lU3R5bGVOb25lCiAgICAgICAgICAgIHdzLlJhbmdlKHdzLkNlbGxzKHdyb3csIHdjb2wpLCB3cy5DZWxscyh3cm93ICsgMywgd2NvbCArIDMpKS5Cb3JkZXJBcm91bmQgVHJ1ZSwgeGxNZWRpdW0gICAgJ+Wkque3mgogICAgICAgIE5leHQKICAgIE5leHQKRW5kIFN1Ygon44OW44Ot44OD44Kv5Y2Y5L2N44GnYXJyMeOBi+OCiWFycjLjgbjou6LpgIEKUHJpdmF0ZSBTdWIgYXJyX21vdmUoQnlWYWwgcm93YiBBcyBMb25nLCBCeVZhbCBjb2xiIEFzIExvbmcsIEJ5UmVmIGFycjEgQXMgVmFyaWFudCwgQnlSZWYgYXJyMiBBcyBWYXJpYW50KQogICAgRGltIHJvdzEgQXMgTG9uZwogICAgRGltIHJvdzIgQXMgTG9uZwogICAgRGltIGNvbDEgQXMgTG9uZwogICAgRGltIGNvbDIgQXMgTG9uZwogICAgRGltIHIgQXMgTG9uZwogICAgRGltIGMgQXMgTG9uZwogICAgRGltIHRlbXAgQXMgVmFyaWFudAogICAgRm9yIHIgPSAxIFRvIDQKICAgICAgICBGb3IgYyA9IDEgVG8gNAogICAgICAgICAgICByb3cxID0gKHJvd2IgLSAxKSAqIDQgKyByCiAgICAgICAgICAgIGNvbDEgPSAoY29sYiAtIDEpICogNCArIGMKICAgICAgICAgICAgcm93MiA9IChjb2xiIC0gMSkgKiA0ICsgcgogICAgICAgICAgICBjb2wyID0gKHJvd2IgLSAxKSAqIDQgKyBjCiAgICAgICAgICAgIGFycjIocm93MiwgY29sMikgPSBhcnIxKHJvdzEsIGNvbDEpCiAgICAgICAgTmV4dAogICAgTmV4dApFbmQgU3ViCg==