VBA・マクロツール

【知らなくても使える】指定したExcelファイルの複数シートを取得するマクロツール_パート2(Excel VBA)

事務作業をするにあたって、他のエクセルファイルの特定のシートを取得して、今開いているエクセルに貼り付けたいと思ったことはないでしょうか。

 

その際に以下の操作を繰り返していないでしょうか。

  1. 対象のExcelファイルを開く。
  2. 取得したいシートで右クリック→「移動またはコピー」をクリックする。
  3. 「移動先ブック」を選択して、「挿入先」を選択し「OK」をクリックする

上記の作業を、取得したいExcelファイル分×対象のシート分繰り返していないでしょうか。

定例の作業を自分の時間を削って、何度も何度も繰り返し行っていては、時間が非常にもったいないです。

 

以前、他ファイルのシートを一発で取得できる『指定したExcelファイルの複数シートを取得するマクロツール』をExcel VBAで作成しましたが、そのツールのパート2になります。

ちなみにパート1は以下になります。

【知らなくても使える】指定したExcelファイルの複数シートを取得するマクロツール(Excel VBA) 事務作業をするにあたって、他のエクセルファイルの特定のシートを取得して、今開いているエクセルに貼り付けたいと思ったことはないでし...

 

当記事にはマクロの元になるExcelファイルがダウンロード可能で、VBAのコードも記事内に記載がありますので、Excel VBAやマクロが良く分からないという方でもすぐに使用できます

当ツールを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

 

『シート一括取得ツール(パート2)』の概要

このエクセルにて、対象のExcelファイルを選択すると、存在するシートを全て取得して表示してくれます。表示されたファイル名とシート名の組合せから選択したシートをエクセルファイル内に貼り付けてくれます

 

Excelにてこの後に紹介するVBAコードを記載したマクロを作成し、ボタンをクリックしてマクロを実行させることでシートを一括取得できます。

 

基本的な機能、操作方法の説明

<手順1>

  1. シート一括取込ツールのマクロが入ったExcelファイル(***.xlsm)を開きます。

 

<手順2>

  1. 「ファイル選択」ボタンをクリックします。

 

<手順3>

  1. 取込むシートがあるExcelファイルを選択します。(複数選択可能)
  2. 「開く」をクリックします。

正常に取込処理が完了すると取り込んだファイルとシートが全て表示されます。

 

<手順4>

  1. 取込むファイルとシートの組合せを選択します。(複数選択可能)
  2. 「シート取込」ボタンをクリックします。

正常に取込処理が完了した場合は、取り込んだシート数が表示されます。

指定したシートがファイル内に取り込まれています。

 

留意事項

指定できるファイルは『Excelファイル』または『CSVファイル』に2種類となります。

 

 

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

以下にその手順を説明していきます。

 

準備の手順

サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

<手順1>

ダウンロードしたExcelファイルを開いて、VBE(Visual Basic Editor)を起動させます。

  1. Excelファイルの上部にあるリボンの「開発」タブを選択します。
  2. 「Visual Basic」をクリックして、VBE(Visual Basic Editor)を起動させます。

 

リボンに「開発」タブが表示されていない場合は、「Excel VBAを始める前の準備 - Excelのリボンに『開発』タブを表示させる」を参照ください。

 

<手順2>

  1. 「Microsoft Excel Object」を右クリックします。
  2. 「挿入」を選択します。
  3. 「標準モジュール」をクリックします。

 

<手順3>

  1. 表示されている右側の欄(エディター)に以下のVBAコードを記載します。


 

コピペするVBAのソースコードはこちら

以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます。

Option Explicit

'---------(設定値)---------------------------
Private Const SHEETNAME_ROW = 6                                 '1.取込むシート名を指定するセルの行番号
Private Const SHEETNAME_COL_NUM = 4                             '2.取込むシート名を指定するセルの列番号
Private Const SETTING_TABLE_NM = "対象ファイル名とシート名"       '3.取込むファイル名とシート名が記載されたテーブル名
Private Const SETTING_TABLE_ROW = 3                             '4.取込むファイル名とシート名が記載されたテーブルの開始行番号
Private Const SETTING_TABLE_COL_NUM = 1                         '5.取込むファイル名とシート名が記載されたテーブルの開始列番号
Private Const SETTING_SHEET_NM = "setting"                      '6.設定シートの名称

'---------(メッセージ)-----------------------
Private Const Msg1 = "シート取得処理が正常に終了しました。"
Private Const Msg2 = "取込件数:"
Private Const Msg3 = "取込むシートがあるExcelファイル等を選択してください。"
Private Const Msg4 = "対象のシートが見つかりませんでした。"
Private Const EMsg1 = "予期せぬエラーが発生しました"
'----------------------------------------------

Dim BaseBook As Workbook
Dim BaseSheet As Worksheet
Dim SettingSht As Worksheet

'===========================================
'対象ファイルを選択した際のメイン処理
'===========================================
Sub 対象ファイル選択_Click()

    On Error GoTo err
        
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set BaseBook = ActiveWorkbook
    Set BaseSheet = ActiveSheet
    Set SettingSht = Worksheets(SETTING_SHEET_NM)
    Dim selBook As Workbook
    Dim tmpSheet As Worksheet

    Dim filePathArr As Variant
    Dim filePath As Variant
    Dim fileName As String
    
    Dim importCnt As Long

    'ダイアログの表示処理
    filePathArr = Application.GetOpenFilename(Filefilter:="Microsoft Excelブックまたはcsvファイル,*.xls?;*.csv", Title:=Msg3, MultiSelect:=True)
    
    Call Initialize
    
    If IsArray(filePathArr) Then
    
        '配列ぶん繰り返しファイルを開く
        For Each filePath In filePathArr
        
            'ファイル名のみを取得する
            fileName = Dir(filePath)
            Workbooks.Open (filePath), UpdateLinks:=1
            Set selBook = ActiveWorkbook
        
            '対象ファイルの全シートを1つずつループして処理する
            For Each tmpSheet In selBook.Worksheets
                
                SettingSht.Cells(SETTING_TABLE_ROW + importCnt, SETTING_TABLE_COL_NUM).Value = filePath
                SettingSht.Cells(SETTING_TABLE_ROW + importCnt, SETTING_TABLE_COL_NUM + 1).Value = fileName
                SettingSht.Cells(SETTING_TABLE_ROW + importCnt, SETTING_TABLE_COL_NUM + 2).Value = tmpSheet.Name
                SettingSht.Cells(SETTING_TABLE_ROW + importCnt, SETTING_TABLE_COL_NUM + 3).Value = fileName & ":" & tmpSheet.Name
                importCnt = importCnt + 1
                
            Next
            
            Workbooks(fileName).Close SaveChanges:=False
            BaseBook.SlicerCaches(1).ClearManualFilter
            
        Next filePath
        
    'キャンセルが選択された場合はダイアログを閉じる
    Else
        End
    End If

    '最初のシートを選択
    Worksheets(BaseSheet.Name).Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
err:
    MsgBox EMsg1
    
End Sub

'===========================================
'シート取込を実行した際のメイン処理
'===========================================
Sub シート取込_Click()

    On Error GoTo err
        
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set BaseBook = ActiveWorkbook
    Set BaseSheet = ActiveSheet
    Set SettingSht = Worksheets(SETTING_SHEET_NM)
    Dim selBook As Workbook
    Dim tgtSheetNm As String
    
    Dim filePath As Variant
    Dim fileName As String
    
    Dim importCnt As Long
    Dim msg As String

    Dim tbl As ListObject
    Dim tblRow As ListRow
    
    ' 対象のテーブルを指定
    Set tbl = SettingSht.ListObjects(SETTING_TABLE_NM) ' テーブル名を変更
        
    ' テーブル内の各行をループ
    For Each tblRow In tbl.ListRows
    
        ' 表示されている行の場合
        If tblRow.Range.EntireRow.Hidden = False Then
            
            filePath = tbl.DataBodyRange.Cells(tblRow.Index, SETTING_TABLE_COL_NUM).Value
            tgtSheetNm = tbl.DataBodyRange.Cells(tblRow.Index, SETTING_TABLE_COL_NUM + 2).Value
            fileName = Dir(filePath)
            
            Workbooks.Open (filePath), UpdateLinks:=1
            Set selBook = ActiveWorkbook

            selBook.Worksheets(tgtSheetNm).Copy After:=BaseBook.Worksheets(BaseBook.Worksheets.Count)
            importCnt = importCnt + 1
        
            Workbooks(fileName).Close SaveChanges:=False
        End If
        
    Next tblRow
    
    If importCnt = 0 Then
        msg = Msg4
    End If
    
    If msg = "" Then
        MsgBox Msg1 & vbLf & Msg2 & importCnt & "件"
    Else
        MsgBox msg
    End If
    
    '最初のシートを選択
    Worksheets(BaseSheet.Name).Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
err:
    MsgBox EMsg1
End Sub

'-------------------------------------------
'対象のファイル名とシート名が記載されたテーブルの初期化処理
'-------------------------------------------
Sub Initialize()

    With SettingSht.ListObjects(SETTING_TABLE_NM)
        If Not .DataBodyRange Is Nothing Then
        
            'すべての行を削除して初期化
            .DataBodyRange.EntireRow.Delete
            
        End If
    End With
    
End Sub

 

<手順4>

マクロを含んだExcelとして、ファイルを保存します。

  1. 左上にある「保存」アイコンをクリックします。
  2. 「ファイルの種類」から「Excelマクロ有効ブック」を選択します。
  3. 「保存」をクリックします。

 

続いて「ファイル選択」と「シート取込」と記載された図形に処理「対象ファイル選択_Click」と「シート取込_Click」のマクロを設定します。

 

<手順5>

「ファイル選択」アイコンにメイン処理「対象ファイル選択_Click」のマクロを設定します。

  1. 「ファイル選択」アイコンを右クリックします。
  2. 「マクロの登録」をクリックします。
  3. 「対象ファイル選択_Click」を選択します。
  4. 「OK」をクリックします。

 

<手順6>

「シート取込」アイコンにメイン処理「シート取込_Click」のマクロを設定します。

  1. 「シート取込」アイコンを右クリックします。
  2. 「マクロの登録」をクリックします。
  3. 「シート取込_Click」を選択します。
  4. 「OK」をクリックします。

 

これで事前準備は完了です。

あとは「基本的な機能、操作方法の説明」で記載された方法でツールを実行できます。

 

なお、当マクロの開発環境は、OS:Windows10 、Excelソフトウェア:Microsoft Office 365となっており、当環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。

正常に動作しない場合は、コメントいただければ幸いです。

 

 

また以下にて、このような業務効率化できるツールを機能ごとの一覧でまとめてますので、ご興味のある方はご覧ください。

 

自力で業務効率化できるツール等を作成する場合は、オンラインITスクール」を利用するとモチベーションを保ちつつ、効率的に学習とアウトプットができると思います。

\ 今なら1か月間全額返金保証!! /

上記の「侍テラコヤ」月額2,980円~ という日本最安級の料金でプログラミング学習ができ、今なら初めての方でも安心できる「1か月全額返金保証」があります

自分に合わないと感じた場合は返金してもらえるため、ノーリスクで試すことができます。是非一度体験してみることをオススメします ^ ^

 

ツールのダウンロードはこちら

下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。

【Excel VBA】シート一括取込ツール

ツールのダウンロードはこちら
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>