古いフォーマットから新しいフォーマットにデータをコピーするVBA

利用シーン

でかいExcel表がある
入力欄が決まっている
入力欄にはセルの名前定義（ブックレベル）が設定されている
定期的に中身を一部書き換えて提出する
ところがたまにフォーマットが変わる
変わるたびに旧ファイルからのコピーが必要
しかもごくたまに一括コピーできないようなセル構造になる

何をするVBA？

旧ファイル（Latestのデータ）と新ファイル（テンプレート）の間で共通する名前定義を使ってデータをコピーする。

ソース

Option Explicit

Sub start_proc()
Dim templateBookPath As String, inputBookPath As String, outputBookPath As String
Dim templateBook As Workbook, inputBook As Workbook

'設定項目の取得
inputBookPath = ThisWorkbook.Names("input_file_path").RefersToRange.Value
outputBookPath = Replace(inputBookPath, ".xls", "_" & Format(Now, "yyyymmddhhmmss") & ".xls")
templateBookPath = ThisWorkbook.Names("template_file_path").RefersToRange.Value
On Error GoTo NO_TEMP_BOOK
Set templateBook = Workbooks.Open(templateBookPath)
On Error GoTo NO_INPUT_BOOK
Set inputBook = Workbooks.Open(inputBookPath, 0, True)
On Error GoTo 0

'テンプレートの名前ループ
Dim tName As Name
Dim i As Long
For i = 1 To templateBook.Names.Count
    Set tName = templateBook.Names(i)
    tName.RefersToRange.Value = getValFromName(inputBook, tName.Name)
Next

'For Each templateBook.Names In tName
'    tName.RefersToRange.Value = getValFromName(inputBook, tName.Name)
'Next

'保存とブッククローズ
templateBook.SaveAs outputBookPath
templateBook.Close False
inputBook.Close False

Exit Sub
NO_TEMP_BOOK:
MsgBox "コピー先のテンプレートファイルの指定が正しくありません"

Exit Sub
NO_INPUT_BOOK:
MsgBox "コピー元のファイルの指定が正しくありません"

End Sub


Function getValFromName(wb As Workbook, nm As String) As Variant
    On Error GoTo Err
    Dim ret
    ret = wb.Names(nm).RefersToRange.Value
    Debug.Print nm & ": " & Left(ret, 10)
    getValFromName = ret
Exit Function
Err:
    Debug.Print nm & ": 対象の名前がありません"
End Function

一緒に使うやつ

セルの値をセルの名前にしてくれるVBA