リンク切れしにくい別ファイルの参照方法【エクセルで転記の自動化】

'--------------------------------------------------------------------------------------
' 外部のExcelブックから、指定されたテーブルの特定の列データを取得し、コピーするプロシージャ。
'--------------------------------------------------------------------------------------
Sub GetDataFromExternalTable()

    ' ## 1. 定数 (Const) の定義
    ' ソースブックの指定
    Const SOURCE_PATH As String = "C:\Users\ユーザー名\Desktop\ソースブック名.xlsx" ' ブックのパス
    Const SOURCE_TBL_NAME As String = "テーブル名" ' テーブル名
    Const SOURCE_COL_NAME As String = "テーブルの見出し" ' テーブルの見出し
    
    ' コピー先ブックの指定
    Const DEST_SHEET_NAME As String = "シート名" ' シート名
    Const DEST_RANGE_START As String = "A1" 'セル（先頭）位置
    
    ' ## 2. 変数宣言
    Dim wbSource As Workbook ' ソースブックオブジェクト
    Dim ws As Worksheet      ' ワークシートオブジェクト (ループ用)
    Dim tbl As ListObject    ' テーブルオブジェクト (ListObject)
    Dim wsDest As Worksheet  ' 転記先ワークシートオブジェクト
    Dim data As Variant      ' 取得したデータを格納する配列
    
    ' ## 3. 環境設定
    Application.ScreenUpdating = False ' 画面更新の停止
    Application.DisplayAlerts = False ' 警告メッセージの非表示
    
    ' ## 4. 外部ブックを開く(読み取り専用)
    On Error Resume Next
    Set wbSource = Workbooks.Open(Filename:=SOURCE_PATH, ReadOnly:=True, UpdateLinks:=0)
    On Error GoTo ErrorHandler ' エラーハンドラを設定し直す

    ' 開けなかった場合のエラーチェック
    If wbSource Is Nothing Then
        MsgBox "エラー: 外部ファイルが見つからないか、開けませんでした。" & vbCrLf & SOURCE_PATH, vbCritical
        GoTo CleanUp
    End If
    
    ' ## 5. データの取得 (テーブルをソースブック内の全シートから探索)
    For Each ws In wbSource.Worksheets
        ' エラー（テーブルがないシートで発生）を無視してテーブルを探す
        On Error Resume Next
        Set tbl = ws.ListObjects(SOURCE_TBL_NAME)
        On Error GoTo ErrorHandler
        
        If Not tbl Is Nothing Then
            ' テーブルが見つかったら、指定列のデータ部分を取得し配列に格納する
            On Error Resume Next
            data = tbl.ListColumns(SOURCE_COL_NAME).DataBodyRange.Value
            On Error GoTo ErrorHandler
            
            ' データが配列として取得できたらループを抜ける
            If IsArray(data) Then
                Exit For
            End If
        End If
    Next ws

    ' データが取得できなかった場合の最終チェック
    If Not IsArray(data) Then
        MsgBox "エラー: 指定されたテーブル名 (" & SOURCE_TBL_NAME & ") または列名 (" & SOURCE_COL_NAME & ") が見つかりませんでした。", vbCritical
        GoTo CleanUp
    End If

    ' ## 6. データの転記
    ' コピー先シートオブジェクトを取得
    On Error Resume Next
    Set wsDest = ThisWorkbook.Sheets(DEST_SHEET_NAME)
    On Error GoTo ErrorHandler
    
    ' コピー先シートの存在チェック
    If wsDest Is Nothing Then
        MsgBox "エラー: 転記先シート (" & DEST_SHEET_NAME & ") がこのブックに見つかりません。", vbCritical
        GoTo CleanUp
    End If
    
    ' 取得した配列のサイズ（行数 UBound(data, 1) と列数 1）に合わせてコピー先の範囲をResizeし、データを一括転記する
    wsDest.Range(DEST_RANGE_START).Resize(UBound(data, 1), 1).Value = data
    
    MsgBox "完了しました！"
    
CleanUp:
    ' # 7. クリーンアップと環境復元
    ' 外部ブックが開いていれば閉じる (保存しない)
    If Not wbSource Is Nothing Then
        wbSource.Close False
    End If
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub ' 正常終了

ErrorHandler:
    ' 予期せぬエラー発生時の処理
    MsgBox "実行時エラーが発生しました: " & Err.Number & " - " & Err.Description, vbCritical
    Resume CleanUp ' クリーンアップに進む
End Sub