http://q.hatena.ne.jp/1240142055の質問で

基本的には単純な置き換えで VBS は VBA で動作できるように変更できます。

今回やったのは下記の内容です。

・最初の部分を Sub で囲む。

・WScript.... を代替関数に置き換える。

（ WScript.Echo は MsgBox でよいと思います。）

今回のコードだとこんな感じになると思いますが、どうでしょうか。

シートにボタンを配置し InsertTags を割り当ててください。

Option Explicit

'---------------------------------------------------------------------
Const INSERT_FILE = "C:\Data\insert.txt" '---  挿入するファイル名の指定
Const HTML_FOLDER = "C:\HTMLFiles"       '---  変換対象ファイルのフォルダを指定
Const KEY_WORD = "</div>"                '---  検索するタグの指定
Const KEY_COUNT = 13                     '---  検索後の置換して位置
'---------------------------------------------------------------------

Sub InsertTags()
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If fso.FileExists(INSERT_FILE) = False Then
        MsgBox "挿入データファイル【" & INSERT_FILE & "】がありません: "
        Exit Sub
    End If
    Dim insData
    insData = fso.OpenTextFile(INSERT_FILE).ReadAll()
    
    Dim fCount
    Dim hFile
    Dim txtData
    Dim pos
    '--- 指定フォルダ内の HTML ファイルを処理
    For Each hFile In fso.GetFolder(HTML_FOLDER).Files
        '--- 拡張子のチェック ---
        If UCase(fso.GetExtensionName(hFile)) = "HTML" Then
            txtData = fso.OpenTextFile(hFile.Path).ReadAll()
            pos = getPos(txtData)
            If pos > 0 Then
                If Mid(txtData, pos + 1, 1) = Chr(10) Or Mid(txtData, pos + 1, 1) = Chr(13) Then
                    txtData = Left(txtData, pos) & vbNewLine & insData & Mid(txtData, pos + 1)
                Else
                    txtData = Left(txtData, pos) & vbNewLine & insData & vbNewLine & Mid(txtData, pos + 1)
                End If
        '--- ファイルをバックアップして更新 ---
                fso.CopyFile hFile.Path, hFile.Path & ".bak"  '--- バックアップが不要な場合はこの行を削除
                fso.CreateTextFile(hFile.Path, True).Write txtData
                fCount = fCount + 1
            Else
        '--- タグが指定回数ない
                MsgBox hFile.Name & "：指定回数の " & KEY_WORD & " がありません。"
            End If
        End If
    Next
    MsgBox fCount & " 個のファイルを処理しました。"
End Sub
    
'---------------------------------------------------------------------
' 挿入位置の検索
'---------------------------------------------------------------------
Function getPos(txtData)
'---------------------------------------------------------------------
    Dim sPos
    Dim dCount
    sPos = InStr(txtData, KEY_WORD)
    Do While sPos > 0
        dCount = dCount + 1
        If dCount = KEY_COUNT Then
            getPos = sPos + Len(KEY_WORD) - 1
            Exit Function
        End If
        sPos = InStr(sPos + 1, txtData, KEY_WORD)
    Loop
End Function

Const INSERT_FILE = "C:\Data\insert.txt"
Const HTML_FOLDER = "C:\HTMLFiles"  

の部分は下記のように書き換えると、セルでファイルやフォルダを指定することができるようにもできます。

Sub InsertTags()
    Dim INSERT_FILE
    INSERT_FILE = Range("A1").Value

    Dim HTML_FOLDER
    HTML_FOLDER = Range("A2").Value

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
       :
       :
       :

挿入する内容をセルで記載する場合は下記のように修正してください。

    Dim insData
    insData = Range("A1").Value