VBAを使って読込先フォルダ指定して他ファイルからデータを読込む
他のExcelファイルのデータを現在開いているExcelシートに貼付る場合、両方のExcelファイルを同時に開いて、コピー貼付けする方法が取られますが、VBAでプログラムを書くと他のExcelファイルをダイアログボックスで選択するだけで選択したファイルのデータを現在開いているシートに貼付けることができます。
とびとびになっているデータを貼付けたり、幾つかのシートにまたがっているデータを貼付ける際に威力を発揮します。
以下は他のExcelファイルを選択してデータをコピーするサンプルアプリです。
他のエクセルファイルからデータを取り込むサンプルアプリの説明
「Ecelファイル読込み」ボタンをクリックして、データ読込み先のファイルを選択し、選択したファイルのデータを読むサンプルアプリです。
１．「Ecelファイル読込み」ボタンをクリックします。
２．データ取り込み先のエクセルファイルを選択する。
３．データが取り込み先からコピーされます。
GetOpenFilenameメソッドとCurrentDirectory プロパティの説明
読込み先Excelファイルをダイアログから選択して、選択したファイルパスを取得するにはGetOpenFilenameメソッドを利用します。
fn = Application.GetOpenFilename((“Excel ファイル (*.xlsm), *.xlsm"), , “ブックを選択して下さい。")
ネットワーク上のサーバーのフォルダや個人用ドキュメントのフォルダなどのWindowsのフォルダを指定するには、ネイティブのWindowsシェルへのアクセスを提供するWScript.ShellのCurrentDirectory プロパティを使用します。WScript.Shell.CurrentDirectoryプロパティは設定したいカレントディレクトリを指定することでカレントディレクトリの変更を行います。
With CreateObject(“WScript.Shell")
.currentdirectory = “D:\サンプルコード"
End With
サンプルアプリのソースコード コードの作成手順はこちら
Sub ボタン1_Click()
Dim wG As Worksheet '読込み元「Sheet1」シート名を格納する変数
Dim start As Integer '最初のデータを格納する変数
Dim fname As String '現在開いているファイル名を格納する変数
Dim fn As String '読込み先ファイルのパスを格納する変数
Dim wb As Workbook '読込み先ブック名を格納する変数
'現在開いているブック名を取得
fname = ThisWorkbook.Name
'現在開いているシート「Sheet1」を選択
Worksheets("Sheet1").Select
'現在開いているシート「Sheet1」を変数「wG」にセット
Set wG = Worksheets("Sheet1")
'現在開いているシート「Sheet1」の現在のデータを削除
Range(Cells(6, 2), Cells(18, 4)).Value = Empty
With CreateObject("WScript.Shell")
'WScript.ShellのCurrentDirectoryプロパティは設定したいカレントディレクトリを指定することでカレントディレクトリの変更を行います。
.currentdirectory = "D:\サンプルコード"
End With
'読込み先Excelファイルをダイアログから選択して、選択したファイルパスを格納する。
fn = Application.GetOpenFilename(("Excel ファイル (*.xlsm), *.xlsm"), , "ブックを選択して下さい。")
'ダイアログでキャンセルした場合
If fn = "False" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
'指定したExcelファイルを変数に格納
Set wb = Workbooks.Open(Filename:=fn, UpdateLinks:=0) '警告を出さずリンクを更新して開きwbとする
'（UpdateLinks:=0 にすると、リンクを更新せずに開きます。）
'６行目からデータの処理を開始する
start = 6
'データの終わりまで１行づつ処理する
Do While wb.Sheets("Sheet1").Cells(start, 3).Value <> "" 'データがなくなるところまでループ処理
wG.Cells(start, 2) = wb.Sheets("Sheet1").Cells(start, 2) '支庁市郡コピー
wG.Cells(start, 3) = wb.Sheets("Sheet1").Cells(start, 3) '区町村名コピー
wG.Cells(start, 4) = wb.Sheets("Sheet1").Cells(start, 4) '区町村区分コピー
start = start + 1 '次のデータに移動
Loop
'警告を出さず保存しないで読込み先のファイルを終了
wb.Close (False)
'読込先ファイルをクリア
Set wb = Nothing
'表示されているを画面を更新
Application.ScreenUpdating = True '画面更新
'現在開いている「Sheet1」シートを選択
Worksheets("Sheet1").Select
End Sub