特定のセルに値を設定する

アンケートをExcelブックで取るとか、
そういう処理において、「氏名を記入してください！！！！」
と言っても聞いてない人がいる。

そんなのは最初から設定してしまえばいい。

ディレクトリ名

ブック名

シート名

セル名

値

の形式のシートを作成して、以下のマクロを実行すると、
該当するセル名のセルに、値を設定してくれる。

Option Explicit

Sub データ設定()
    Dim bkInput As Workbook
    Set bkInput = ThisWorkbook
    Dim shtInput As Worksheet
    Set shtInput = bkInput.Sheets(1)
    Dim bkOutput As Workbook
    Set bkOutput = Workbooks.Add
    shtInput.Copy Before:=bkOutput.Sheets(1)
    Dim shtOutput As Worksheet
    Set shtOutput = bkOutput.Sheets(1)
    
    Dim sPath As String
    Dim sBook As String
    Dim sSheet As String
    
    Application.DisplayAlerts = False
    
    Dim nRow As Integer
    nRow = 2
    Do While shtOutput.Cells(nRow, 1) <> ""
        sPath = shtOutput.Cells(nRow, 1)
        sBook = shtOutput.Cells(nRow, 2)
        sSheet = shtOutput.Cells(nRow, 3)
        
        Dim bkData As Workbook
        Dim shtData As Worksheet
        
        Set bkData = Workbooks.Open(Filename:=sPath & "\" & sBook, ReadOnly:=False)
        Set shtData = bkData.Worksheets(sSheet)
        
        shtData.Range(shtOutput.Cells(nRow, 4)).Value = shtOutput.Cells(nRow, 5)

        bkData.Save
        bkData.Close

        nRow = nRow + 1
    Loop
    
    Application.DisplayAlerts = True
    
End Sub