VBA　他のブックから名前を参照して、名前の数分、値を同じ名前と日付のセルに入れたい

前提・実現したいこと

別のブックにあるスケジュールの作業名を工数表の項目と日付が一緒のところのセルに工数の値
を入力したいのですが、
VBAの内容に何が足りていないのかが分からず、悩んでいます。
どこを改良すればうまく動きますでしょうか。

手順
転記元ファイルのシート1のEからRまでの範囲を一列ごとに指定
空なら翌日に移動
列の単語ごとに何個ずつあるか計算し、0.5を掛ける
出した値を列の日付と項目の名前が同じところにあるセルに入力
その列で単語がなくなるまで繰り返す
単語がなくなったら翌日の実績列に移動
日曜日まで終わったら隣のシートに移動
シートがなくなるまで繰り返す

転記元のシート名は毎回異なる
転記元の日付は日付が入っているセルの左に書いてある

予定表　一週間ごとに別のシート　ここの作業名の数を合計して0.5掛ける　その他は無視する

工数表　項目は複数存在

↓マクロ起動後

工数がM4セルから入力される。
集計し終わったら、下の項目に移動して、項目がなくなるまで続ける

該当のソースコード

Sub KosuBook()
    Dim ex      As Excel.Application    '処理用Excel
    Dim wb      As Workbook
    Dim sPath                               'ブックファイルパス
    Dim sht     As Worksheet                '参照シート
    Dim bFlg    As Boolean
    Dim kRow    As Long
    Dim cnt     As Long
    Dim i, j, k, kosu As Long
    
    
    '開くブックを指定
    sPath = "〇〇〇.xlsm"
    
    '既に開かれているか確認
    bFlg = IsBookOpened(sPath)
    
    '開かれている場合
    If bFlg = True Then
        Set ex = New Excel.Application
        '新規Excelで読み取り専用で開く
        Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Else
        '現ブックで読み取り専用で開く
        Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    End If
    
    '工数を集計後、同じ工数にあたる項目を探し、合計を入力する
    '1yori
    '1と後の数字名シートの数だけ繰り返し
    For i = 1 To Worksheets.Count
        '列ごとに繰り返し
        For j = 6 To 18 Step 2
            '最後のセルまで取得
            kRow = Cells(Rows.Count, j).End(xlUp).Row
            '調べる作業名（重複は除く）
            
            k = 0
                Do
                    n = InStr(k + 1, kRow, '作業名)
                            If k = 0 Then
                                Exit Do
                            Else
                                cnt = cnt + 1
                            End If
                Loop
                kousu = cnt * 0.5
                '工数表のブックへ内容をコピー
                    
        Next j
    Next　i

    
    'ブックを閉じる
    Call wb.Close
    
    If bFlg = True Then
        Call ex.Application.Quit
    End If
    
    
End Sub
 
'ブックオープン判定関数
Function IsBookOpened(a_sFilePath) As Boolean
    On Error Resume Next
    
    '保存済みのブックか判定
    Open a_sFilePath For Append As #1
    Close #1
    
    If Err.Number > 0 Then
        '既に開かれている場合
        IsBookOpened = True
    Else
        '開かれていない場合
        IsBookOpened = False
    End If
End Function

補足情報（FW/ツールのバージョンなど）

win10(64bit)

meg_

2020/08/03 08:13

現状どうなっていて何に困っているのでしょうか？

質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう！

前提・実現したいこと

該当のソースコード

補足情報（FW/ツールのバージョンなど）

関連した質問