Option Explicit
 
Public Sub 転記()
    Dim ws1 As Worksheet    '転記元シート
    Dim ws2 As Worksheet    '転記先シート
    Dim lastRow As Long     '転記元最終行
    Dim pno As Long         '転記元ページ番号
    Dim prow As Long        '転記元ページ番号対応行番号
    Dim max_pno As Long     '転記元ページ番号
    Dim ino As Long         '転記元ページ内番号
    Dim row1 As Long        '転記元ページ及びページ内番号に対応した行番号
    Dim col1 As Long        '転記元ページ及びページ内番号に対応した列番号
    Dim pno2 As Long        '転記先ページ番号
    Dim ino2 As Long        '転記先ページ内番号
    Dim row2 As Long        '転記先ページ及びページ内番号に対応した行番号
    Dim col2 As Long        '転記先ページ及びページ内番号に対応した列番号
    max_pno = 0
    Set ws1 = Workbooks("下書き.xlsx").Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("評価1")
    lastRow = ws1.Cells(Rows.Count, "B").End(xlUp).row
    '最大ページ番号を探す
    For pno = 1 To 999
        prow = getRowNo(pno)
        If prow > lastRow Then Exit For
        If ws1.Cells(prow, "B").Value <> "番号" Then
            MsgBox ("転記元 " & pno & "ページ先頭が""番号""でない")
            ws1.Activate
            ws1.Cells(prow, "B").Select
            Exit Sub
        End If
        max_pno = pno
    Next
    For pno = 1 To max_pno
        For ino = 1 To 4
            '転記元のページ番号、ページ内番号から、転記先のページ番号、ページ内番号を取得
            Call get_trg_pno_ino(pno, ino, pno2, ino2)
            '転記元のページ番号、ページ内番号から、転記元の行番号、列番号を取得
            Call get_src_row_col(pno, ino, row1, col1)
            '転記先のページ番号、ページ内番号から、転記先の行番号、列番号を取得
            Call get_trg_row_col(pno2, ino2, row2, col2)
            ws2.Cells(row2, col2 + 2).Value = ws1.Cells(row1, col1 + 2).Value           '番号
            ws2.Cells(row2, col2 + 6).Value = ws1.Cells(row1, col1 + 6).Value           '個別ランク
            ws2.Cells(row2 + 1, col2 + 2).Value = ws1.Cells(row1 + 1, col1 + 2).Value   '種類
            ws2.Cells(row2 + 1, col2 + 6).Value = ws1.Cells(row1 + 1, col1 + 6).Value   '今回総評
            ws2.Cells(row2 + 2, col2 + 2).Value = ws1.Cells(row1 + 2, col1 + 2).Value   '担当者
            ws2.Cells(row2 + 2, col2 + 6).Value = ws1.Cells(row1 + 2, col1 + 6).Value   '前回総評
            ws2.Cells(row2 + 2, col2 + 6).Value = ws1.Cells(row1 + 2, col1 + 6).Value   '前回総評
            ws2.Cells(row2 + 3, col2).Value = ws1.Cells(row1 + 3, col1).Value           '名称不明
            ws2.Cells(row2 + 4, col2 + 6).Value = ws1.Cells(row1 + 4, col1 + 6).Value   '備考
        Next
    Next
    MsgBox ("完了")
End Sub
'転記元のページ番号から行番号を取得する
Private Function getRowNo(ByVal pno As Long) As Long
    getRowNo = (pno - 1) * 23 + 3
End Function
'転記元先のページ番号から行番号を取得する
Private Function getTrgRowNo(ByVal pno2 As Long) As Long
    getTrgRowNo = (pno2 - 1) * 23 + 3
End Function
'転記元のページ番号、ページ内番号から転記先のページ番号、ページ内番号を取得する
Private Sub get_trg_pno_ino(ByVal pno As Long, ByVal ino As Long, ByRef pno2 As Long, ByRef ino2 As Long)
    Dim seqno As Long
    seqno = (pno - 1) * 4 + ino
    pno2 = (seqno - 1) \ 6 + 1
    ino2 = (seqno - 1) Mod 6 + 1
End Sub
'転記元のページ番号、ページ内番号から転記元の行番号、列番号を取得する
Private Sub get_src_row_col(ByVal pno As Long, ByVal ino As Long, ByRef row1 As Long, ByRef col1 As Long)
    row1 = getRowNo(pno)
    If ino > 2 Then
        row1 = row1 + 10
    End If
    col1 = 2 + ((ino - 1) Mod 2) * 8
End Sub
'転記先のページ番号、ページ内番号から転記先の行番号、列番号を取得する
Private Sub get_trg_row_col(ByVal pno2 As Long, ByVal ino2 As Long, ByRef row2 As Long, ByRef col2 As Long)
    row2 = getTrgRowNo(pno2)
    If ino2 > 3 Then
        row2 = row2 + 10
    End If
    col2 = 2 + ((ino2 - 1) Mod 3) * 8
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOi7ouiomCgpCiAgICBEaW0gd3MxIEFzIFdvcmtzaGVldCAgICAn6Lui6KiY5YWD44K344O844OICiAgICBEaW0gd3MyIEFzIFdvcmtzaGVldCAgICAn6Lui6KiY5YWI44K344O844OICiAgICBEaW0gbGFzdFJvdyBBcyBMb25nICAgICAn6Lui6KiY5YWD5pyA57WC6KGMCiAgICBEaW0gcG5vIEFzIExvbmcgICAgICAgICAn6Lui6KiY5YWD44Oa44O844K455Wq5Y+3CiAgICBEaW0gcHJvdyBBcyBMb25nICAgICAgICAn6Lui6KiY5YWD44Oa44O844K455Wq5Y+35a++5b+c6KGM55Wq5Y+3CiAgICBEaW0gbWF4X3BubyBBcyBMb25nICAgICAn6Lui6KiY5YWD44Oa44O844K455Wq5Y+3CiAgICBEaW0gaW5vIEFzIExvbmcgICAgICAgICAn6Lui6KiY5YWD44Oa44O844K45YaF55Wq5Y+3CiAgICBEaW0gcm93MSBBcyBMb25nICAgICAgICAn6Lui6KiY5YWD44Oa44O844K45Y+K44Gz44Oa44O844K45YaF55Wq5Y+344Gr5a++5b+c44GX44Gf6KGM55Wq5Y+3CiAgICBEaW0gY29sMSBBcyBMb25nICAgICAgICAn6Lui6KiY5YWD44Oa44O844K45Y+K44Gz44Oa44O844K45YaF55Wq5Y+344Gr5a++5b+c44GX44Gf5YiX55Wq5Y+3CiAgICBEaW0gcG5vMiBBcyBMb25nICAgICAgICAn6Lui6KiY5YWI44Oa44O844K455Wq5Y+3CiAgICBEaW0gaW5vMiBBcyBMb25nICAgICAgICAn6Lui6KiY5YWI44Oa44O844K45YaF55Wq5Y+3CiAgICBEaW0gcm93MiBBcyBMb25nICAgICAgICAn6Lui6KiY5YWI44Oa44O844K45Y+K44Gz44Oa44O844K45YaF55Wq5Y+344Gr5a++5b+c44GX44Gf6KGM55Wq5Y+3CiAgICBEaW0gY29sMiBBcyBMb25nICAgICAgICAn6Lui6KiY5YWI44Oa44O844K45Y+K44Gz44Oa44O844K45YaF55Wq5Y+344Gr5a++5b+c44GX44Gf5YiX55Wq5Y+3CiAgICBtYXhfcG5vID0gMAogICAgU2V0IHdzMSA9IFdvcmtib29rcygi5LiL5pu444GNLnhsc3giKS5Xb3Jrc2hlZXRzKCJTaGVldDEiKQogICAgU2V0IHdzMiA9IFRoaXNXb3JrYm9vay5Xb3Jrc2hlZXRzKCLoqZXkvqExIikKICAgIGxhc3RSb3cgPSB3czEuQ2VsbHMoUm93cy5Db3VudCwgIkIiKS5FbmQoeGxVcCkucm93CiAgICAn5pyA5aSn44Oa44O844K455Wq5Y+344KS5o6i44GZCiAgICBGb3IgcG5vID0gMSBUbyA5OTkKICAgICAgICBwcm93ID0gZ2V0Um93Tm8ocG5vKQogICAgICAgIElmIHByb3cgPiBsYXN0Um93IFRoZW4gRXhpdCBGb3IKICAgICAgICBJZiB3czEuQ2VsbHMocHJvdywgIkIiKS5WYWx1ZSA8PiAi55Wq5Y+3IiBUaGVuCiAgICAgICAgICAgIE1zZ0JveCAoIui7ouiomOWFgyAiICYgcG5vICYgIuODmuODvOOCuOWFiOmgreOBjCIi55Wq5Y+3IiLjgafjgarjgYQiKQogICAgICAgICAgICB3czEuQWN0aXZhdGUKICAgICAgICAgICAgd3MxLkNlbGxzKHByb3csICJCIikuU2VsZWN0CiAgICAgICAgICAgIEV4aXQgU3ViCiAgICAgICAgRW5kIElmCiAgICAgICAgbWF4X3BubyA9IHBubwogICAgTmV4dAogICAgRm9yIHBubyA9IDEgVG8gbWF4X3BubwogICAgICAgIEZvciBpbm8gPSAxIFRvIDQKICAgICAgICAgICAgJ+i7ouiomOWFg+OBruODmuODvOOCuOeVquWPt+OAgeODmuODvOOCuOWGheeVquWPt+OBi+OCieOAgei7ouiomOWFiOOBruODmuODvOOCuOeVquWPt+OAgeODmuODvOOCuOWGheeVquWPt+OCkuWPluW+lwogICAgICAgICAgICBDYWxsIGdldF90cmdfcG5vX2lubyhwbm8sIGlubywgcG5vMiwgaW5vMikKICAgICAgICAgICAgJ+i7ouiomOWFg+OBruODmuODvOOCuOeVquWPt+OAgeODmuODvOOCuOWGheeVquWPt+OBi+OCieOAgei7ouiomOWFg+OBruihjOeVquWPt+OAgeWIl+eVquWPt+OCkuWPluW+lwogICAgICAgICAgICBDYWxsIGdldF9zcmNfcm93X2NvbChwbm8sIGlubywgcm93MSwgY29sMSkKICAgICAgICAgICAgJ+i7ouiomOWFiOOBruODmuODvOOCuOeVquWPt+OAgeODmuODvOOCuOWGheeVquWPt+OBi+OCieOAgei7ouiomOWFiOOBruihjOeVquWPt+OAgeWIl+eVquWPt+OCkuWPluW+lwogICAgICAgICAgICBDYWxsIGdldF90cmdfcm93X2NvbChwbm8yLCBpbm8yLCByb3cyLCBjb2wyKQogICAgICAgICAgICB3czIuQ2VsbHMocm93MiwgY29sMiArIDIpLlZhbHVlID0gd3MxLkNlbGxzKHJvdzEsIGNvbDEgKyAyKS5WYWx1ZSAgICAgICAgICAgJ+eVquWPtwogICAgICAgICAgICB3czIuQ2VsbHMocm93MiwgY29sMiArIDYpLlZhbHVlID0gd3MxLkNlbGxzKHJvdzEsIGNvbDEgKyA2KS5WYWx1ZSAgICAgICAgICAgJ+WAi+WIpeODqeODs+OCrwogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDEsIGNvbDIgKyAyKS5WYWx1ZSA9IHdzMS5DZWxscyhyb3cxICsgMSwgY29sMSArIDIpLlZhbHVlICAgJ+eorumhngogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDEsIGNvbDIgKyA2KS5WYWx1ZSA9IHdzMS5DZWxscyhyb3cxICsgMSwgY29sMSArIDYpLlZhbHVlICAgJ+S7iuWbnue3j+iplQogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDIsIGNvbDIgKyAyKS5WYWx1ZSA9IHdzMS5DZWxscyhyb3cxICsgMiwgY29sMSArIDIpLlZhbHVlICAgJ+aLheW9k+iAhQogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDIsIGNvbDIgKyA2KS5WYWx1ZSA9IHdzMS5DZWxscyhyb3cxICsgMiwgY29sMSArIDYpLlZhbHVlICAgJ+WJjeWbnue3j+iplQogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDIsIGNvbDIgKyA2KS5WYWx1ZSA9IHdzMS5DZWxscyhyb3cxICsgMiwgY29sMSArIDYpLlZhbHVlICAgJ+WJjeWbnue3j+iplQogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDMsIGNvbDIpLlZhbHVlID0gd3MxLkNlbGxzKHJvdzEgKyAzLCBjb2wxKS5WYWx1ZSAgICAgICAgICAgJ+WQjeensOS4jeaYjgogICAgICAgICAgICB3czIuQ2VsbHMocm93MiArIDQsIGNvbDIgKyA2KS5WYWx1ZSA9IHdzMS5DZWxscyhyb3cxICsgNCwgY29sMSArIDYpLlZhbHVlICAgJ+WCmeiAgwogICAgICAgIE5leHQKICAgIE5leHQKICAgIE1zZ0JveCAoIuWujOS6hiIpCkVuZCBTdWIKJ+i7ouiomOWFg+OBruODmuODvOOCuOeVquWPt+OBi+OCieihjOeVquWPt+OCkuWPluW+l+OBmeOCiwpQcml2YXRlIEZ1bmN0aW9uIGdldFJvd05vKEJ5VmFsIHBubyBBcyBMb25nKSBBcyBMb25nCiAgICBnZXRSb3dObyA9IChwbm8gLSAxKSAqIDIzICsgMwpFbmQgRnVuY3Rpb24KJ+i7ouiomOWFg+WFiOOBruODmuODvOOCuOeVquWPt+OBi+OCieihjOeVquWPt+OCkuWPluW+l+OBmeOCiwpQcml2YXRlIEZ1bmN0aW9uIGdldFRyZ1Jvd05vKEJ5VmFsIHBubzIgQXMgTG9uZykgQXMgTG9uZwogICAgZ2V0VHJnUm93Tm8gPSAocG5vMiAtIDEpICogMjMgKyAzCkVuZCBGdW5jdGlvbgon6Lui6KiY5YWD44Gu44Oa44O844K455Wq5Y+344CB44Oa44O844K45YaF55Wq5Y+344GL44KJ6Lui6KiY5YWI44Gu44Oa44O844K455Wq5Y+344CB44Oa44O844K45YaF55Wq5Y+344KS5Y+W5b6X44GZ44KLClByaXZhdGUgU3ViIGdldF90cmdfcG5vX2lubyhCeVZhbCBwbm8gQXMgTG9uZywgQnlWYWwgaW5vIEFzIExvbmcsIEJ5UmVmIHBubzIgQXMgTG9uZywgQnlSZWYgaW5vMiBBcyBMb25nKQogICAgRGltIHNlcW5vIEFzIExvbmcKICAgIHNlcW5vID0gKHBubyAtIDEpICogNCArIGlubwogICAgcG5vMiA9IChzZXFubyAtIDEpIFwgNiArIDEKICAgIGlubzIgPSAoc2Vxbm8gLSAxKSBNb2QgNiArIDEKRW5kIFN1Ygon6Lui6KiY5YWD44Gu44Oa44O844K455Wq5Y+344CB44Oa44O844K45YaF55Wq5Y+344GL44KJ6Lui6KiY5YWD44Gu6KGM55Wq5Y+344CB5YiX55Wq5Y+344KS5Y+W5b6X44GZ44KLClByaXZhdGUgU3ViIGdldF9zcmNfcm93X2NvbChCeVZhbCBwbm8gQXMgTG9uZywgQnlWYWwgaW5vIEFzIExvbmcsIEJ5UmVmIHJvdzEgQXMgTG9uZywgQnlSZWYgY29sMSBBcyBMb25nKQogICAgcm93MSA9IGdldFJvd05vKHBubykKICAgIElmIGlubyA+IDIgVGhlbgogICAgICAgIHJvdzEgPSByb3cxICsgMTAKICAgIEVuZCBJZgogICAgY29sMSA9IDIgKyAoKGlubyAtIDEpIE1vZCAyKSAqIDgKRW5kIFN1Ygon6Lui6KiY5YWI44Gu44Oa44O844K455Wq5Y+344CB44Oa44O844K45YaF55Wq5Y+344GL44KJ6Lui6KiY5YWI44Gu6KGM55Wq5Y+344CB5YiX55Wq5Y+344KS5Y+W5b6X44GZ44KLClByaXZhdGUgU3ViIGdldF90cmdfcm93X2NvbChCeVZhbCBwbm8yIEFzIExvbmcsIEJ5VmFsIGlubzIgQXMgTG9uZywgQnlSZWYgcm93MiBBcyBMb25nLCBCeVJlZiBjb2wyIEFzIExvbmcpCiAgICByb3cyID0gZ2V0VHJnUm93Tm8ocG5vMikKICAgIElmIGlubzIgPiAzIFRoZW4KICAgICAgICByb3cyID0gcm93MiArIDEwCiAgICBFbmQgSWYKICAgIGNvbDIgPSAyICsgKChpbm8yIC0gMSkgTW9kIDMpICogOApFbmQgU3ViCg==