【VBA】開いているExcelファイルと同じフォルダ内にあるファイルのシートを取り込む方法

今回は、例えば同じフォルダにある「list.xls」ファイルから「list」シートを現在開いているExcelファイルに取り込む方法をVBAで実現します。このプロセスを段階的に解説していきます。

必要な変数の宣言
現在のブックの設定
取り込むファイルのパス設定
元ブックを開く
エラーチェック
「list」シートの取得
シートの存在確認
シートのコピー
元ブックを閉じる
1完了メッセージの表示
コード
まとめ

必要な変数の宣言

まず、使用する変数を宣言します。

Dim 元ブック As Workbook
Dim 元シート As Worksheet
Dim 現在のブック As Workbook
Dim ファイルパス As String

これらの変数は、元のブック（list.xls）、取り込むシート、現在のブック、そしてファイルのパスを格納するために使用します。

現在のブックの設定

現在開いているブックを変数に設定します。

Set 現在のブック = ThisWorkbook

ThisWorkbookは、このVBAコードが格納されているブックを指します。

取り込むファイルのパス設定

「list.xls」ファイルのパスを設定します。

ファイルパス = ThisWorkbook.Path & "\list.xls"

ThisWorkbook.Pathで現在のブックのフォルダパスを取得し、そこに”\list.xls”を追加してファイルパスを作成します。

元ブックを開く

設定したファイルパスを使用して「list.xls」を開きます。

On Error Resume Next
Set 元ブック = Workbooks.Open(ファイルパス)
On Error GoTo 0

エラーハンドリングを使用して、ファイルが見つからない場合に備えています。

エラーチェック

ファイルが正常に開けたかチェックします。

If 元ブック Is Nothing Then
    MsgBox "list.xlsファイルが見つかりません。", vbExclamation
    Exit Sub
End If

ファイルが見つからない場合、メッセージを表示してサブルーチンを終了します。

「list」シートの取得

開いたブックから「list」シートを取得します。

On Error Resume Next
Set 元シート = 元ブック.Sheets("list")
On Error GoTo 0

ここでもエラーハンドリングを使用して、シートが存在しない場合に備えています。

シートの存在確認

「list」シートが存在するかチェックします。

If 元シート Is Nothing Then
    MsgBox "listシートが見つかりません。", vbExclamation
    元ブック.Close SaveChanges:=False
    Exit Sub
End If

シートが見つからない場合、メッセージを表示し、元ブックを閉じてサブルーチンを終了します。

シートのコピー

「list」シートを現在のブックにコピーします。

元シート.Copy After:=現在のブック.Sheets(現在のブック.Sheets.Count)

このコードは、「list」シートを現在のブックの最後のシートの後ろにコピーします。

元ブックを閉じる

使用が終わった元ブックを閉じます。

元ブック.Close SaveChanges:=False

SaveChanges:=Falseを指定することで、変更を保存せずに閉じます。

1完了メッセージの表示

最後に、処理が完了したことを知らせるメッセージを表示します。

MsgBox "listシートを取り込みました。", vbInformation

コード

同じフォルダ内にある「list.xls」ファイルの「list」シートを現在開いているファイルに取り込むためのVBAコードです。

Sub リストシート取り込み()
    Dim 元ブック As Workbook
    Dim 元シート As Worksheet
    Dim 現在のブック As Workbook
    Dim ファイルパス As String
    
    '現在のブックを設定
    Set 現在のブック = ThisWorkbook
    
    'list.xlsのファイルパスを設定
    ファイルパス = ThisWorkbook.Path & "\list.xls"
    
    '元ブックを開く
    On Error Resume Next
    Set 元ブック = Workbooks.Open(ファイルパス)
    On Error GoTo 0
    
    If 元ブック Is Nothing Then
        MsgBox "list.xlsファイルが見つかりません。", vbExclamation
        Exit Sub
    End If
    
    'listシートを取得
    On Error Resume Next
    Set 元シート = 元ブック.Sheets("list")
    On Error GoTo 0
    
    If 元シート Is Nothing Then
        MsgBox "listシートが見つかりません。", vbExclamation
        元ブック.Close SaveChanges:=False
        Exit Sub
    End If
    
    '元シートを現在のブックにコピー
    元シート.Copy After:=現在のブック.Sheets(現在のブック.Sheets.Count)
    
    '元ブックを閉じる
    元ブック.Close SaveChanges:=False
    
    MsgBox "listシートを取り込みました。", vbInformation
End Sub