test

Option Explicit

Sub CopyData()

    Dim tgtRow As ListRow
    
    ' 申請書ファイルを開く
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "申請書.xlsx"
    
    ' 「読み取り」シートのセルA1にある数字を読み取る
'    Dim sheetNum As Integer
'    sheetNum = Workbooks("申請書.xlsx").Sheets("読み取り").Range("A1").Value
    
    ' 読み取った数字に対応するシートを選ぶ
'    Workbooks("申請書.xlsx").Sheets(sheetNum).Select
    
    ' テーブル名「Shinsei」の情報を読み取る
    Dim tbl As ListObject
    Set tbl = Workbooks("申請書.xlsx").Sheets(1).ListObjects("route")
    
    ' とりまとめファイルを開く
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "とりまとめ.xlsx"
    
    ' テーブル名「Torimatome」にShinseiの情報を転記する
    Dim tgtTbl As ListObject
    Set tgtTbl = Workbooks("とりまとめ.xlsx").Sheets(1).ListObjects("route")
    
    
    Dim i As Integer
    For i = 1 To 4
    
    
    ' 判定カラムの値に応じて、行を追加または削除する
    Dim judge As Integer
    judge = tbl.ListRows(i).Range.Columns(1).Value
    
    If judge = 1 Then ' 判定カラムが1ならば、行を追加する
        Set tgtRow = tgtTbl.ListRows.Add
        tbl.ListRows(1).Range.Copy tgtRow.Range
    ElseIf judge = 2 Then ' 判定カラムが2ならば、対応する行を削除する
    
     Dim j As Long
     
     For j = 1 To tgtTbl.DataBodyRange.Count
        If tgtTbl.DataBodyRange(j, 2).Value = tbl.DataBodyRange(i, 2).Value Then
            Set tgtRow = tgtTbl.ListRows(j) ' 削除する行を指定する
            tgtRow.Delete
            Exit For
        End If
     Next j
     
    ElseIf judge = "" Then ' 判定カラムがならば、対応する行を削除する
    Exit For
    Else ' 判定カラムが1または2以外の場合、エラーメッセージを表示する
        MsgBox "判定カラムの値が不正です。", vbExclamation, "エラー"
    End If
    
    Next i
    
    
    ' 申請書ファイルととりまとめファイルを保存して閉じる
    Workbooks("申請書.xlsx").Save
    Workbooks("申請書.xlsx").Close
    Workbooks("とりまとめ.xlsx").Save
    Workbooks("とりまとめ.xlsx").Close
End Sub

Sub ReadFiles()
    ' フォルダのパスを指定する
    Dim folderPath As String
    folderPath = "C:\example\folder"
    
    ' 指定したフォルダ内のすべてのExcelファイルに対してループを実行する
    Dim file As String
    file = Dir(folderPath & "\*.xlsx")
    Do While file <> ""
        ' Excelファイルを開く
        Dim wb As Workbook
        Set wb = Workbooks.Open(folderPath & "\" & file)
        
        ' 上書き保存するシートを指定する
        Dim ws As Worksheet
        Set ws = wb.Sheets("Sheet1")
        
        ' シートに対して上書き保存を実行する
        ws.Range("A1").Value = "New Value"
        wb.Save
        
        ' Excelファイルを閉じる
        wb.Close SaveChanges:=False
        
        ' 次のファイルに進む
        file = Dir()
    Loop
End Sub