Option Explicit
    Dim gakunen(99) As Boolean          '学年（1～99）
    Dim kumi(99, 99) As Long            '組　学年（1～99）組（１～99）
Public Sub 自動転記()
    Dim str As String
    Dim msg As String
    Dim test_no As Long
    Dim ans As Integer
    Dim ms As Worksheet
    Dim ws As Worksheet
    Dim wrow As Long
    Dim wcol As Long
    Dim i As Long
    Dim j As Long
    Dim book_name As String
    Dim book_path As String
    Dim sheet_name As String
    Dim wb As Workbook
    Call init_table
    str = InputBox("テスト回入力(1～7)")
    If str = "" Then Exit Sub
    If IsNumeric(str) = False Then Exit Sub
    test_no = CLng(str)
    If test_no < 1 Or test_no > 7 Then Exit Sub
    msg = "第" & test_no & "回テスト結果の集計を実施します"
    If MsgBox(msg, vbOKCancel) <> vbOK Then Exit Sub
    Set ms = Worksheets("集計")
    '集計シートのクラスを記憶
    Call set_gakunen(ms, 1)
    Call set_gakunen(ms, 7)
    Call set_gakunen(ms, 13)
    Application.ScreenUpdating = False
 
    '全学年の処理
    For i = 1 To 99
        If gakunen(i) = True Then
            book_name = i & "年テストデータ.xlsx"
            book_path = ThisWorkbook.Path & "\" & book_name
            If Dir(book_path) = "" Then
                MsgBox (book_path & "が存在しません")
                Exit Sub
            End If
            Set wb = Workbooks.Open(book_path)
            For j = 1 To 99
                If kumi(i, j) <> 0 Then
                    sheet_name = "普" & j
                    If check_sheet_name(wb, sheet_name) = False Then
                        MsgBox (book_name & "内に[" & sheet_name & "]が存在しません")
                        Exit Sub
                    End If
                    Set ws = wb.Worksheets(sheet_name)
                    Call set_data(ms, test_no, kumi(i, j), ws)
                End If
            Next
            wb.Save
            wb.Close
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox ("完了")
End Sub
'テーブル初期化
Private Sub init_table()
    Dim i As Long
    Dim j As Long
    For i = 1 To 99
        gakunen(i) = False
        For j = 1 To 99
            kumi(i, j) = 0
        Next
    Next
End Sub
'学年、組の合計の位置を記憶
Private Sub set_gakunen(ByVal ms As Worksheet, ByVal wcol As Long)
    Dim maxrow As Long
    Dim wrow As Long
    Dim gak As String
    Dim key As String
    Dim elm As Variant
    Dim i As Long
    Dim j As Long
    maxrow = ms.Cells(Rows.Count, wcol).End(xlUp).Row    'sheetの最大行取得
    For wrow = 2 To maxrow
        gak = ms.Cells(wrow, wcol).Value
        If gak <> "" Then
            key = ms.Cells(wrow, wcol + 1).Value
            elm = Split(key, "普")
            If UBound(elm) <> 1 Then
                Call err_msg(ms, wrow, wcol + 1, "集計シート：クラス不正（不正フォーマット）")
            End If
            If elm(0) <> gak Then
                Call err_msg(ms, wrow, wcol + 1, "集計シート：クラス不正（学年不一致）")
            End If
            If IsNumeric(elm(0)) = False Or IsNumeric(elm(1)) = False Then
                Call err_msg(ms, wrow, wcol + 1, "集計シート：クラス不正（学年又は組が数字以外）")
            End If
            i = CLng(elm(0))
            j = CLng(elm(1))
            If i < 1 Or i > 99 Or j < 1 Or j > 99 Then
                Call err_msg(ms, wrow, wcol + 1, "集計シート：クラス不正（学年又は組が範囲外）")
            End If
            If kumi(i, j) <> 0 Then
                Call err_msg(ms, wrow, wcol + 1, "集計シート：クラス重複")
            End If
            '合計セルの行番号、列番号を記憶(xxxyyy:xxx=行番号、yyy=列番号)
            kumi(i, j) = wrow * 1000 + wcol + 2
            gakunen(i) = True
        End If
    Next
End Sub
'シート名チェック
Private Function check_sheet_name(ByRef wb As Workbook, ByVal sheet_name As String) As Boolean
    Dim i As Long
    check_sheet_name = True
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Name = sheet_name Then Exit Function
    Next
    check_sheet_name = False
End Function
 
 
'エラー表示及び停止
Private Sub err_msg(ByVal ws As Worksheet, ByVal erow As Long, ByVal ecol As Long, ByVal msg As String)
    ws.Activate
    ws.Cells(erow, ecol).Select
    MsgBox (msg)
    End
End Sub
 
'データ設定（合計、人数、平均）
Private Sub set_data(ByRef ms As Worksheet, ByVal test_no As Long, ByVal row_col As Long, ByRef ws As Worksheet)
    Dim srow As Long
    Dim scol As Long
    Dim wrow As Long
    Dim wcol As Long
    srow = row_col \ 1000
    scol = row_col Mod 1000
    wcol = 3 + test_no
    For wrow = 45 To 47
        ws.Cells(wrow, wcol).Value = ms.Cells(srow, scol).Value
        scol = scol + 1
    Next
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0CiAgICBEaW0gZ2FrdW5lbig5OSkgQXMgQm9vbGVhbiAgICAgICAgICAn5a2m5bm077yIMe+9njk577yJCiAgICBEaW0ga3VtaSg5OSwgOTkpIEFzIExvbmcgICAgICAgICAgICAn57WE44CA5a2m5bm077yIMe+9njk577yJ57WE77yI77yR772eOTnvvIkKUHVibGljIFN1YiDoh6rli5Xou6LoqJgoKQogICAgRGltIHN0ciBBcyBTdHJpbmcKICAgIERpbSBtc2cgQXMgU3RyaW5nCiAgICBEaW0gdGVzdF9ubyBBcyBMb25nCiAgICBEaW0gYW5zIEFzIEludGVnZXIKICAgIERpbSBtcyBBcyBXb3Jrc2hlZXQKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIERpbSB3cm93IEFzIExvbmcKICAgIERpbSB3Y29sIEFzIExvbmcKICAgIERpbSBpIEFzIExvbmcKICAgIERpbSBqIEFzIExvbmcKICAgIERpbSBib29rX25hbWUgQXMgU3RyaW5nCiAgICBEaW0gYm9va19wYXRoIEFzIFN0cmluZwogICAgRGltIHNoZWV0X25hbWUgQXMgU3RyaW5nCiAgICBEaW0gd2IgQXMgV29ya2Jvb2sKICAgIENhbGwgaW5pdF90YWJsZQogICAgc3RyID0gSW5wdXRCb3goIuODhuOCueODiOWbnuWFpeWKmygx772eNykiKQogICAgSWYgc3RyID0gIiIgVGhlbiBFeGl0IFN1YgogICAgSWYgSXNOdW1lcmljKHN0cikgPSBGYWxzZSBUaGVuIEV4aXQgU3ViCiAgICB0ZXN0X25vID0gQ0xuZyhzdHIpCiAgICBJZiB0ZXN0X25vIDwgMSBPciB0ZXN0X25vID4gNyBUaGVuIEV4aXQgU3ViCiAgICBtc2cgPSAi56ysIiAmIHRlc3Rfbm8gJiAi5Zue44OG44K544OI57WQ5p6c44Gu6ZuG6KiI44KS5a6f5pa944GX44G+44GZIgogICAgSWYgTXNnQm94KG1zZywgdmJPS0NhbmNlbCkgPD4gdmJPSyBUaGVuIEV4aXQgU3ViCiAgICBTZXQgbXMgPSBXb3Jrc2hlZXRzKCLpm4boqIgiKQogICAgJ+mbhuioiOOCt+ODvOODiOOBruOCr+ODqeOCueOCkuiomOaGtgogICAgQ2FsbCBzZXRfZ2FrdW5lbihtcywgMSkKICAgIENhbGwgc2V0X2dha3VuZW4obXMsIDcpCiAgICBDYWxsIHNldF9nYWt1bmVuKG1zLCAxMykKICAgIEFwcGxpY2F0aW9uLlNjcmVlblVwZGF0aW5nID0gRmFsc2UKICAgCiAgICAn5YWo5a2m5bm044Gu5Yem55CGCiAgICBGb3IgaSA9IDEgVG8gOTkKICAgICAgICBJZiBnYWt1bmVuKGkpID0gVHJ1ZSBUaGVuCiAgICAgICAgICAgIGJvb2tfbmFtZSA9IGkgJiAi5bm044OG44K544OI44OH44O844K/Lnhsc3giCiAgICAgICAgICAgIGJvb2tfcGF0aCA9IFRoaXNXb3JrYm9vay5QYXRoICYgIlwiICYgYm9va19uYW1lCiAgICAgICAgICAgIElmIERpcihib29rX3BhdGgpID0gIiIgVGhlbgogICAgICAgICAgICAgICAgTXNnQm94IChib29rX3BhdGggJiAi44GM5a2Y5Zyo44GX44G+44Gb44KTIikKICAgICAgICAgICAgICAgIEV4aXQgU3ViCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICBTZXQgd2IgPSBXb3JrYm9va3MuT3Blbihib29rX3BhdGgpCiAgICAgICAgICAgIEZvciBqID0gMSBUbyA5OQogICAgICAgICAgICAgICAgSWYga3VtaShpLCBqKSA8PiAwIFRoZW4KICAgICAgICAgICAgICAgICAgICBzaGVldF9uYW1lID0gIuaZriIgJiBqCiAgICAgICAgICAgICAgICAgICAgSWYgY2hlY2tfc2hlZXRfbmFtZSh3Yiwgc2hlZXRfbmFtZSkgPSBGYWxzZSBUaGVuCiAgICAgICAgICAgICAgICAgICAgICAgIE1zZ0JveCAoYm9va19uYW1lICYgIuWGheOBq1siICYgc2hlZXRfbmFtZSAmICJd44GM5a2Y5Zyo44GX44G+44Gb44KTIikKICAgICAgICAgICAgICAgICAgICAgICAgRXhpdCBTdWIKICAgICAgICAgICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgICAgICAgICBTZXQgd3MgPSB3Yi5Xb3Jrc2hlZXRzKHNoZWV0X25hbWUpCiAgICAgICAgICAgICAgICAgICAgQ2FsbCBzZXRfZGF0YShtcywgdGVzdF9ubywga3VtaShpLCBqKSwgd3MpCiAgICAgICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgTmV4dAogICAgICAgICAgICB3Yi5TYXZlCiAgICAgICAgICAgIHdiLkNsb3NlCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IFRydWUKICAgIE1zZ0JveCAoIuWujOS6hiIpCkVuZCBTdWIKJ+ODhuODvOODluODq+WIneacn+WMlgpQcml2YXRlIFN1YiBpbml0X3RhYmxlKCkKICAgIERpbSBpIEFzIExvbmcKICAgIERpbSBqIEFzIExvbmcKICAgIEZvciBpID0gMSBUbyA5OQogICAgICAgIGdha3VuZW4oaSkgPSBGYWxzZQogICAgICAgIEZvciBqID0gMSBUbyA5OQogICAgICAgICAgICBrdW1pKGksIGopID0gMAogICAgICAgIE5leHQKICAgIE5leHQKRW5kIFN1Ygon5a2m5bm044CB57WE44Gu5ZCI6KiI44Gu5L2N572u44KS6KiY5oa2ClByaXZhdGUgU3ViIHNldF9nYWt1bmVuKEJ5VmFsIG1zIEFzIFdvcmtzaGVldCwgQnlWYWwgd2NvbCBBcyBMb25nKQogICAgRGltIG1heHJvdyBBcyBMb25nCiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICBEaW0gZ2FrIEFzIFN0cmluZwogICAgRGltIGtleSBBcyBTdHJpbmcKICAgIERpbSBlbG0gQXMgVmFyaWFudAogICAgRGltIGkgQXMgTG9uZwogICAgRGltIGogQXMgTG9uZwogICAgbWF4cm93ID0gbXMuQ2VsbHMoUm93cy5Db3VudCwgd2NvbCkuRW5kKHhsVXApLlJvdyAgICAnc2hlZXTjga7mnIDlpKfooYzlj5blvpcKICAgIEZvciB3cm93ID0gMiBUbyBtYXhyb3cKICAgICAgICBnYWsgPSBtcy5DZWxscyh3cm93LCB3Y29sKS5WYWx1ZQogICAgICAgIElmIGdhayA8PiAiIiBUaGVuCiAgICAgICAgICAgIGtleSA9IG1zLkNlbGxzKHdyb3csIHdjb2wgKyAxKS5WYWx1ZQogICAgICAgICAgICBlbG0gPSBTcGxpdChrZXksICLmma4iKQogICAgICAgICAgICBJZiBVQm91bmQoZWxtKSA8PiAxIFRoZW4KICAgICAgICAgICAgICAgIENhbGwgZXJyX21zZyhtcywgd3Jvdywgd2NvbCArIDEsICLpm4boqIjjgrfjg7zjg4jvvJrjgq/jg6njgrnkuI3mraPvvIjkuI3mraPjg5Xjgqnjg7zjg57jg4Pjg4jvvIkiKQogICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgSWYgZWxtKDApIDw+IGdhayBUaGVuCiAgICAgICAgICAgICAgICBDYWxsIGVycl9tc2cobXMsIHdyb3csIHdjb2wgKyAxLCAi6ZuG6KiI44K344O844OI77ya44Kv44Op44K55LiN5q2j77yI5a2m5bm05LiN5LiA6Ie077yJIikKICAgICAgICAgICAgRW5kIElmCiAgICAgICAgICAgIElmIElzTnVtZXJpYyhlbG0oMCkpID0gRmFsc2UgT3IgSXNOdW1lcmljKGVsbSgxKSkgPSBGYWxzZSBUaGVuCiAgICAgICAgICAgICAgICBDYWxsIGVycl9tc2cobXMsIHdyb3csIHdjb2wgKyAxLCAi6ZuG6KiI44K344O844OI77ya44Kv44Op44K55LiN5q2j77yI5a2m5bm05Y+I44Gv57WE44GM5pWw5a2X5Lul5aSW77yJIikKICAgICAgICAgICAgRW5kIElmCiAgICAgICAgICAgIGkgPSBDTG5nKGVsbSgwKSkKICAgICAgICAgICAgaiA9IENMbmcoZWxtKDEpKQogICAgICAgICAgICBJZiBpIDwgMSBPciBpID4gOTkgT3IgaiA8IDEgT3IgaiA+IDk5IFRoZW4KICAgICAgICAgICAgICAgIENhbGwgZXJyX21zZyhtcywgd3Jvdywgd2NvbCArIDEsICLpm4boqIjjgrfjg7zjg4jvvJrjgq/jg6njgrnkuI3mraPvvIjlrablubTlj4jjga/ntYTjgYznr4Tlm7LlpJbvvIkiKQogICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgSWYga3VtaShpLCBqKSA8PiAwIFRoZW4KICAgICAgICAgICAgICAgIENhbGwgZXJyX21zZyhtcywgd3Jvdywgd2NvbCArIDEsICLpm4boqIjjgrfjg7zjg4jvvJrjgq/jg6njgrnph43opIciKQogICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgJ+WQiOioiOOCu+ODq+OBruihjOeVquWPt+OAgeWIl+eVquWPt+OCkuiomOaGtih4eHh5eXk6eHh4PeihjOeVquWPt+OAgXl5eT3liJfnlarlj7cpCiAgICAgICAgICAgIGt1bWkoaSwgaikgPSB3cm93ICogMTAwMCArIHdjb2wgKyAyCiAgICAgICAgICAgIGdha3VuZW4oaSkgPSBUcnVlCiAgICAgICAgRW5kIElmCiAgICBOZXh0CkVuZCBTdWIKJ+OCt+ODvOODiOWQjeODgeOCp+ODg+OCrwpQcml2YXRlIEZ1bmN0aW9uIGNoZWNrX3NoZWV0X25hbWUoQnlSZWYgd2IgQXMgV29ya2Jvb2ssIEJ5VmFsIHNoZWV0X25hbWUgQXMgU3RyaW5nKSBBcyBCb29sZWFuCiAgICBEaW0gaSBBcyBMb25nCiAgICBjaGVja19zaGVldF9uYW1lID0gVHJ1ZQogICAgRm9yIGkgPSAxIFRvIHdiLldvcmtzaGVldHMuQ291bnQKICAgICAgICBJZiB3Yi5Xb3Jrc2hlZXRzKGkpLk5hbWUgPSBzaGVldF9uYW1lIFRoZW4gRXhpdCBGdW5jdGlvbgogICAgTmV4dAogICAgY2hlY2tfc2hlZXRfbmFtZSA9IEZhbHNlCkVuZCBGdW5jdGlvbgoKCifjgqjjg6njg7zooajnpLrlj4rjgbPlgZzmraIKUHJpdmF0ZSBTdWIgZXJyX21zZyhCeVZhbCB3cyBBcyBXb3Jrc2hlZXQsIEJ5VmFsIGVyb3cgQXMgTG9uZywgQnlWYWwgZWNvbCBBcyBMb25nLCBCeVZhbCBtc2cgQXMgU3RyaW5nKQogICAgd3MuQWN0aXZhdGUKICAgIHdzLkNlbGxzKGVyb3csIGVjb2wpLlNlbGVjdAogICAgTXNnQm94IChtc2cpCiAgICBFbmQKRW5kIFN1YgoKJ+ODh+ODvOOCv+ioreWumu+8iOWQiOioiOOAgeS6uuaVsOOAgeW5s+Wdh++8iQpQcml2YXRlIFN1YiBzZXRfZGF0YShCeVJlZiBtcyBBcyBXb3Jrc2hlZXQsIEJ5VmFsIHRlc3Rfbm8gQXMgTG9uZywgQnlWYWwgcm93X2NvbCBBcyBMb25nLCBCeVJlZiB3cyBBcyBXb3Jrc2hlZXQpCiAgICBEaW0gc3JvdyBBcyBMb25nCiAgICBEaW0gc2NvbCBBcyBMb25nCiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICBEaW0gd2NvbCBBcyBMb25nCiAgICBzcm93ID0gcm93X2NvbCBcIDEwMDAKICAgIHNjb2wgPSByb3dfY29sIE1vZCAxMDAwCiAgICB3Y29sID0gMyArIHRlc3Rfbm8KICAgIEZvciB3cm93ID0gNDUgVG8gNDcKICAgICAgICB3cy5DZWxscyh3cm93LCB3Y29sKS5WYWx1ZSA9IG1zLkNlbGxzKHNyb3csIHNjb2wpLlZhbHVlCiAgICAgICAgc2NvbCA9IHNjb2wgKyAxCiAgICBOZXh0CkVuZCBTdWIKCg==