Excel VBA シート一括取得マクロ(コピペで使える便利機能)

事務作業をするにあたって、他のエクセルファイルからこのシートを取得して、今開いているエクセルに貼り付けたいけど、対象のシートが多くて嫌になるな。。。

操作する工程が多すぎてめんどくさいなあ。。。ということを思ったことはないでしょうか。

 

そこで、取得するシートを指定して、対象のエクセルファイルを選択するだけで、該当するシートを全て取得するマクロを作成しましたので、ご活用頂けたらと思います。

 

シート一括取得マクロの概要

このエクセルでシート名を指定して(指定がなければ全シート)、対象のエクセルファイルを選択すれば該当するシートを全て取得して、このエクセルファイルに貼り付けてくれます

 

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

 

何ができるマクロなのか?

1.シート一括取得マクロのVBAコードを含んだExcelファイル(***.xlsm)を開きます。

 

2.B2セルに取り込むシート名を入力して、図形にカーソルを当てて、指の形になっているのを確認してクリックします。

(※何も値が入っていない場合は、選択したエクセルファイルにある全てのシートを取り込みます。)

 

3.取り込むシートがあるエクセルファイルを選択して、開くをクリックします。

※正常に取込処理が完了すると取り込んだシート数が表示されます。

 

4.取り込んだエクセルファイルに存在するシートを取り込むことができました。

 

フォルダ自動作成マクロの使用方法

1.Excelを開き、「開発」タブをクリックして、「Visial Basic」をクリックします。

 

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

 

3.右側の空欄スペースに下記のVBAコードをコピペで入力します。

 

VBAコードが以下になります、このコードを「module1」の欄にコピペしてください。


Option Explicit

Sub import_sheet()

    On Error GoTo err
        
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim filePath As String
    Dim fileName As String
    
    Dim baseBook As Workbook
    Set baseBook = ActiveWorkbook
    Dim selBook As Workbook
    Dim baseSheet As Worksheet
    Set baseSheet = ActiveSheet
    Dim tmpSheet As Worksheet

    Dim tgtSheetNm As String
    Dim importCnt As Long
    Dim msg As String
        
    '指定された「取り込むするシート名」を取得する
    tgtSheetNm = baseSheet.Cells(2, 2).Value

    'ダイアログの表示処理
    filePath = Application.GetOpenFilename(Filefilter:="Microsoft Excelブック,*.xls?,csvファイル,*.csv", Title:="取り込むシートがあるexcelファイルを開いてください。")

    If filePath <> "False" Then
        
        'ファイル名のみを取得する
        fileName = Dir(filePath)
        Workbooks.Open (filePath), UpdateLinks:=1
        Set selBook = ActiveWorkbook
        
        '対象ファイルの全シートを1つずつループして処理する
        For Each tmpSheet In selBook.Worksheets
        
            '対象のシートが存在する場合はコピー処理をする
            If tgtSheetNm = "" Or _
                (tgtSheetNm <> "" And tmpSheet.Name = tgtSheetNm) Or _
                (tgtSheetNm <> "" And tmpSheet.Name Like tgtSheetNm) Then
                selBook.Worksheets(tmpSheet.Name).Copy After:=baseBook.Worksheets(baseSheet.Name)
                importCnt = importCnt + 1
            End If
        Next
        
        Workbooks(fileName).Close SaveChanges:=True
        
        If importCnt = 0 Then
            msg = "対象のシートが見つかりませんでした。"
        End If
        
        If msg = "" Then
            MsgBox "シート取得処理が正常に終了しました。" & vbLf & "取込件数:" & importCnt & "件"
        Else
            MsgBox msg
        End If
        
    'キャンセルが選択された場合はダイアログを閉じる
    Else
        End
    End If
    
    '最初のシートを選択
    Worksheets(baseSheet.Name).Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
err:
    MsgBox "予期せぬエラーが発生しました。"
    
End Sub

 

4.ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。

 

5.「挿入」→「図形」→「四角形」からボタンの形をした図形を作成します。

6.図形の中のテキストは任意ですが「シート取込」にします。

 

7.図形にカーソルを合わせ右クリック→「マクロの登録」→「import_sheet」を選択して「OK」ボタンをクリックします。

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

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

 

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

シート取込ツール

上記よりダウンロードして、VBAコードを組み込んでマクロを使用してください。
※マクロをインターネットからダウンロードするのはリスクを伴うと思いますので、マクロ入りでなくエクセル形式でアップロードしています。

上のほうで書いたVBAコードを記載して.xlsm形式(マクロの形式)で保存したら動作します。

Follow me!

コメントを残す

CAPTCHA