複数のMicorosoft Excelブックにあるワークシートマクロを一括入替え

各組織別に配布して使っているマクロ付きワークブック、追加要望があったのだけど
ワークシートマクロの方を一括で入れ替えることができないと、移行が現実的でないな、と方法がを探しましたが
「見つかりません」
それでも"addFromstring"という命令を使えばなんとかなりそうなことはわかったので、
作ってみました。
（"標準モジュール"の入替えはできるんだけどな。）

　サブルーチンとして、対象ブックが書き換え可能で開けるか？を作ってますが、これについては別途
https://qiita.com/hurry1000/items/551b5d41fe2d5f9467ed
で紹介しています。

Const 入替対象ブック一覧
で指定したシートをまず作って、
ここに入れ替える必要のあるフォルダとファイルを
１列目フォルダ名（Const フォルダ名列）、２列めブック名（Const ブック名列）
として縦に並べて入れちゃいます。

シートの１行目はタイトルとして２行目から入れます。（Const データ開始行）

入れ替え対象のブックは本マクロのあるブックのサブフォルダにおいて、
１列目のフォルダ名はサブフォルダ名から書き始めてね。
（ブック名 = ThisWorkbook.Path & "" & Cells(i, フォルダ名列).Value
でフルパス名を作ってます。）
ちなみに１列目をブランクにすると、同じワークブックにあるブックを対象にして入れ替えます。

　ワークシートマクロは１シートに１つしか指定できない（だよね）ということを利用して
入替えるワークシートを本マクロのあるブックに綴じ込んで、そのシートをアクティブにした上で、メニューからマクロを実行します。（実際にはワークシート名が入替え対象のブックにあるシート名と一致していればよろし。）
　間違ってマクロのないシートをアクティブにしたまま実行すると、エラーメッセージ出して落ちます。一度シートマクロをクリアするので、こういった安全装置は絶対に必要。

　入れ替えようとしたブックが見つからなかった場合は、ブック名を書いたセルが赤くなり、開いても誰かが使用中だった場合は黄色く塗られます。

　再実行時に「すでに書き換えたブックは対象としたくない」という場合は（あるいはテストで１組織の分だけ入替えたいという場合は）、対象としない行を非表示にすると読み飛ばします。

（自分では実運用を考えて設計しているつもりなのだが、なぜ「お前のマクロは難しい」と言われるのだろうか？都度条件を考えながら実行／再実行or結果検証するほうがよほど難しいと思うのだが。）

Sub ワークシートマクロコピー()

Const 入替対象ブック一覧 = "入替対象ブック名"
Const データ開始行 = 2
Const フォルダ名列 = 1
Const ブック名列 = 2

Dim srcName As String 'copy元シート (アクティブシート)
Dim dstName As String 'copy先シート (元シートと同一名称)

Dim srcWB As Workbook 'copy元ブック(本ブック)
Dim dstWB As Workbook 'copy

Dim srcVBP As Object 'copy元ブックのVBProject
Dim dstVBP As Object 'copy先ブックのVBProject

Dim srcMod As Object 'copy元コード
Dim dstMod As Object 'copy先コード

Dim i As Long
Dim 最終行 As Long
Dim ブック名 As String

    Set srcWB = ThisWorkbook
    Set srcVBP = srcWB.VBProject.VBComponents

    srcName = ActiveSheet.Name
    dstName = srcName
    Set srcMod = srcVBP(srcWB.Sheets(srcName).CodeName).codemodule
    
    If srcMod.countoflines = 0 Then
        MsgBox ("たぶんマクロのないシートが選ばれています。 ")
        Exit Sub
    End If

    Worksheets(入替対象ブック一覧).Activate
    最終行 = Cells(Rows.Count, ブック名列).End(xlUp).Row
    
    For i = データ開始行 To 最終行

        ' 非表示にした行は読み飛ばす
        If Rows(i).Hidden = False Then
        
            '本ブックと同じフォルダに入替対象ブックがある場合
            If Len(Cells(i, フォルダ名列).Value) = 0 Then
                ブック名 = ThisWorkbook.Path & _
                "" & Cells(i, ブック名列).Value
            Else
            '本ブックのサブフォルダに入替ブックがある場合
                ブック名 = ThisWorkbook.Path & _
                        "\" & Cells(i, フォルダ名列).Value & _
                        "\" & Cells(i, ブック名列).Value
            End If
                
            '書き込み可能でブックを開ければ
                
            If OpenBookWritable(ブック名) Then
                Set dstWB = Workbooks(ブック名)
                Set dstVBP = dstWB.VBProject.VBComponents
                Set dstMod = dstVBP(dstWB.Sheets(dstName).CodeName).codemodule

                Call dstMod.deletelines(1, dstMod.countoflines)
                Call dstMod.addFromstring(srcMod.Lines(1, srcMod.countoflines))
                
                Workbooks(ブック名).Save
                Workbooks(ブック名).Close
                
                Set dstMod = Nothing
                Set dstVBP = Nothing
                Set dstWB = Nothing
                
                '開けた場合はブック名のセルの色をなしにする。
                Cells(i, ブック名列).Interior.ColorIndex = 0
            Else
                '開けなかった場合はブック名のセルを黄色く塗る。
                Cells(i, ブック名列).Interior.ColorIndex = 6
                
                'ファイルがなかった場合はブック名のセルの色を赤で塗る。
                If ブック名 = vbNullString Then
                    Cells(i, ブック名列).Interior.ColorIndex = 3
                End If
            End If
        End If
        
        DoEvents
    Next i
    
    Set srcMod = Nothing
    Set srcVBP = Nothing
    Set srcWB = Nothing

    MsgBox "終了"
    
    End Sub