Option Explicit
    Dim month_sheet As Worksheet    '月集計シート
    Dim month_row As Long           '月集計シートの行番号
Public Sub 日報転記()
    Dim wday As Long        '日数
    month_row = 3
    Set month_sheet = Worksheets("月集計")
    '月集計の3行目以降をクリア
    month_sheet.Rows("3:" & Rows.count).ClearContents
    '1日～31日まで繰り返す
    For wday = 1 To 31
        '1日分の日報シートを転記
        Call set_1day(wday)
    Next
    MsgBox ("完了")
End Sub
'1日分の日報シート転記
Private Sub set_1day(ByVal wday As Long)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim wrow As Long
    '指定日(wday)に対応する日報シートを取得する
    Call get_day_sheet(wday, ws)
    lastRow = ws.Cells(Rows.count, "B").End(xlUp).Row    'B列の最終行取得
    For wrow = 5 To lastRow
        'A列が●のみ転記する
        If ws.Cells(wrow, "A").Value <> "" Then
            '月集計シートへ転記
            month_sheet.Cells(month_row, "A").Resize(1, 13).Value = ws.Cells(wrow, "B").Resize(1, 13).Value
            month_row = month_row + 1
        End If
    Next
End Sub
'指定日(wday)に対応する日報シートを取得する
Private Sub get_day_sheet(ByVal wday As Long, ByRef ws As Worksheet)
    Dim sname As String
    Dim i As Long
    sname = wday & "日"
    For i = 1 To Worksheets.count
        If Worksheets(i).Name = sname Then
            Set ws = Worksheets(i)
            Exit Sub
        End If
    Next
    MsgBox ("日報シート【" & sname & "】がありません")
    End
End Sub
 

T3B0aW9uIEV4cGxpY2l0CiAgICBEaW0gbW9udGhfc2hlZXQgQXMgV29ya3NoZWV0ICAgICfmnIjpm4boqIjjgrfjg7zjg4gKICAgIERpbSBtb250aF9yb3cgQXMgTG9uZyAgICAgICAgICAgJ+aciOmbhuioiOOCt+ODvOODiOOBruihjOeVquWPtwpQdWJsaWMgU3ViIOaXpeWgsei7ouiomCgpCiAgICBEaW0gd2RheSBBcyBMb25nICAgICAgICAn5pel5pWwCiAgICBtb250aF9yb3cgPSAzCiAgICBTZXQgbW9udGhfc2hlZXQgPSBXb3Jrc2hlZXRzKCLmnIjpm4boqIgiKQogICAgJ+aciOmbhuioiOOBrjPooYznm67ku6XpmY3jgpLjgq/jg6rjgqIKICAgIG1vbnRoX3NoZWV0LlJvd3MoIjM6IiAmIFJvd3MuY291bnQpLkNsZWFyQ29udGVudHMKICAgICcx5pel772eMzHml6Xjgb7jgafnubDjgorov5TjgZkKICAgIEZvciB3ZGF5ID0gMSBUbyAzMQogICAgICAgICcx5pel5YiG44Gu5pel5aCx44K344O844OI44KS6Lui6KiYCiAgICAgICAgQ2FsbCBzZXRfMWRheSh3ZGF5KQogICAgTmV4dAogICAgTXNnQm94ICgi5a6M5LqGIikKRW5kIFN1YgonMeaXpeWIhuOBruaXpeWgseOCt+ODvOODiOi7ouiomApQcml2YXRlIFN1YiBzZXRfMWRheShCeVZhbCB3ZGF5IEFzIExvbmcpCiAgICBEaW0gd3MgQXMgV29ya3NoZWV0CiAgICBEaW0gbGFzdFJvdyBBcyBMb25nCiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICAn5oyH5a6a5pelKHdkYXkp44Gr5a++5b+c44GZ44KL5pel5aCx44K344O844OI44KS5Y+W5b6X44GZ44KLCiAgICBDYWxsIGdldF9kYXlfc2hlZXQod2RheSwgd3MpCiAgICBsYXN0Um93ID0gd3MuQ2VsbHMoUm93cy5jb3VudCwgIkIiKS5FbmQoeGxVcCkuUm93ICAgICdC5YiX44Gu5pyA57WC6KGM5Y+W5b6XCiAgICBGb3Igd3JvdyA9IDUgVG8gbGFzdFJvdwogICAgICAgICdB5YiX44GM4peP44Gu44G/6Lui6KiY44GZ44KLCiAgICAgICAgSWYgd3MuQ2VsbHMod3JvdywgIkEiKS5WYWx1ZSA8PiAiIiBUaGVuCiAgICAgICAgICAgICfmnIjpm4boqIjjgrfjg7zjg4jjgbjou6LoqJgKICAgICAgICAgICAgbW9udGhfc2hlZXQuQ2VsbHMobW9udGhfcm93LCAiQSIpLlJlc2l6ZSgxLCAxMykuVmFsdWUgPSB3cy5DZWxscyh3cm93LCAiQiIpLlJlc2l6ZSgxLCAxMykuVmFsdWUKICAgICAgICAgICAgbW9udGhfcm93ID0gbW9udGhfcm93ICsgMQogICAgICAgIEVuZCBJZgogICAgTmV4dApFbmQgU3ViCifmjIflrprml6Uod2RheSnjgavlr77lv5zjgZnjgovml6XloLHjgrfjg7zjg4jjgpLlj5blvpfjgZnjgosKUHJpdmF0ZSBTdWIgZ2V0X2RheV9zaGVldChCeVZhbCB3ZGF5IEFzIExvbmcsIEJ5UmVmIHdzIEFzIFdvcmtzaGVldCkKICAgIERpbSBzbmFtZSBBcyBTdHJpbmcKICAgIERpbSBpIEFzIExvbmcKICAgIHNuYW1lID0gd2RheSAmICLml6UiCiAgICBGb3IgaSA9IDEgVG8gV29ya3NoZWV0cy5jb3VudAogICAgICAgIElmIFdvcmtzaGVldHMoaSkuTmFtZSA9IHNuYW1lIFRoZW4KICAgICAgICAgICAgU2V0IHdzID0gV29ya3NoZWV0cyhpKQogICAgICAgICAgICBFeGl0IFN1YgogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgTXNnQm94ICgi5pel5aCx44K344O844OI44CQIiAmIHNuYW1lICYgIuOAkeOBjOOBguOCiuOBvuOBm+OCkyIpCiAgICBFbmQKRW5kIFN1Ygo=