【VBS・VBA共通】複数のExcelブックを開いてシートを新規ブックにコピー

VBA
スポンサーリンク

今回の記事では、VBScriptやVBAを使って特定のフォルダにある複数のExcelブックを開き、なかのシートコピーして、新しく作成したExcelブック貼り付ける一連の処理のサンプルプログラムを紹介します。

尚、当サンプルプログラムはVBScriptで作成していますが、VBAでもこのままSubプロシージャをコピペしてもらえれば動作します。

後、VBAを使う場合は当然そうですが、VBScriptから実行する場合でも、実行環境にExcelがインストールされていないと動作しません。
 

サンプルプログラムの実装内容

当サンプルプログラムでは、以下の前提条件や処理内容で実装しています。

  • コピー元のExcelファイル群は変数：sourceFolderで定義したフォルダ名に置かれている。
  • sourceFolderで定義したフォルダはVBSファイル、又はxlsmファイルのカレントディレクトリに配置。
  • 新規ブックを作成して、そのブックにコピー元ブックのシートを全て貼り付ける。
  • 新規ブック作成時に生成されるシート「Sheet1」の前、又は後ろにコピー元シートを貼り付ける。
  • 新規ブックへ全てコピーした後に、シートの並び替え用のサンプルコードも掲載。
  • シートのコピーと並び替え終了後に自動作成されたシート「Sheet1」の削除も行う。
  • コピー元ブックは保存せずに閉じて、コピー先ブックは名前を付けて保存して閉じる。
  • 当処理では使用しないが、シート名の存在チェック用のFunctionプロシージャもおまけで紹介。

尚、VBScriptでWScript.Shellからカレントディレクトリを取得した場合と、VBAでWScript.Shellからカレントディレクトリを取得する場合では挙動が異なります。

Set objShell = CreateObject("WScript.Shell")
objShell.CurrentDirectory

上記のコードをVBScriptとVBAのそれぞれで実行した場合、VBScriptではVBSファイル(自分自身)の場所を返します。
VBAではWScript.ShellのCurrentDirectoryと書いてもファイルの場所は返しません。

VBAで実行する場合に、この処理の行については別途書き換えて使用してください。
 
 

コピペで動くサンプルプログラム

以下のサンプルプログラムはVBScriptとVBAのどちらでも動作します。
また、VBAではVBE側での参照設定も不要です。

  Option Explicit
  'メイン処理を実行します。
  Call ExcelSheetCopy

  Sub ExcelSheetCopy()

      Dim objExcel
      Dim objNewBook
      Dim objSrcBook
      Dim i
      Dim objFS
      Dim objFile
      Dim objFolder
      Dim CreateFileName
      Dim objShell
      Dim currentDir
      Dim sourceFolder

      sourceFolder = "コピー元ブックフォルダ"

      'Excelオブジェクトを作成します。
      Set objExcel = CreateObject("Excel.Application")
      '警告を非表示
      objExcel.DisplayAlerts = False
      'Excelは表示※必要によってFalseに変更してくだい。
      objExcel.Visible = True
      'コピー先の新規ブックを作成します。
      Set objNewBook = objExcel.Workbooks.Add

      Set objFS = CreateObject("Scripting.FileSystemObject")
      Set objShell = CreateObject("WScript.Shell")
      currentDir = objShell.CurrentDirectory
      'フォルダオブジェクトを作成します。
      Set objFolder = objFS.GetFolder(currentDir & "\" & sourceFolder)
      'フォルダオブジェクト内のファイルリストでループします。
      For Each objFile in objFolder.files
          '既存のBookを開きます。
          Set objSrcBook = objExcel.Workbooks.Open(objFile.Path)
          'コピー元ブック内のシートの数分ループします。
          For i = 1 To objSrcBook.Sheets.Count
              '開いた既存Bookのシートをコピーします。
              '常にSheet1の前の位置に貼り付けするには以下
              'objSrcBook.Worksheets(i).Copy objNewBook.Worksheets("Sheet1")
              'VBAだと以下の記述でも同じ動きです。※VBSでは構文エラー
              'objSrcBook.Worksheets(i).Copy Before := objNewBook.Worksheets("Sheet1")

              '常にSheet1の後ろの位置に貼り付けするなら以下※第一引数は空白
              objSrcBook.Worksheets(i).Copy ,objNewBook.Worksheets("Sheet1")
              'VBAだと以下の記述でも同じ動きです。※VBSでは構文エラー
              'objSrcBook.Worksheets(i).Copy After := objNewBook.Worksheets("Sheet1")
          Next
          objSrcBook.Close False
      Next

      '必要によってシートを並び替えます。
      '並び替えの例：シート名「テスト1」をSheet1の前に移動させます。
      objNewBook.Worksheets("テスト1").Move objNewBook.Worksheets("Sheet1")
      '並び替えの例：シート名「テスト1」をSheet1の後ろに移動させます。
      objNewBook.Worksheets("テスト1").Move ,objNewBook.Worksheets("Sheet1")

      '不要なシートを削除します。
      'xlsxでは既定でSheet1のみ作成され、xls形式のファイルではSheet1からSheet3まで作成される。
      objNewBook.Worksheets("Sheet1").Delete
      'objNewBook.Worksheets("Sheet2").Delete
      'objNewBook.Worksheets("Sheet3").Delete

      CreateFileName = "test.xlsx"

      'Excel 2007以前のxls形式で作成する場合は、引数に56の指定も必要。
      'Call objNewBook.SaveAs(currentDir & "\" & CreateFileName,56)
      Call objNewBook.SaveAs(currentDir & "\" & CreateFileName)

      objNewBook.Close True
      'Excelオブジェクトを終了します。
      objExcel.Quit

      Set objSrcBook= Nothing
      Set objNewBook = Nothing
      Set objExcel = Nothing
      Set objFile = Nothing
      Set objFolder = Nothing
      Set objFS = Nothing
      Set objShell = Nothing
  End Sub

  '【おまけ】
  '第一引数で渡されたワークブックオブジェクトに対して、第二引数のシート名が存在しているかを返します。
  '戻り値：真偽　存在していればTrue
  Function Is_ExistSheetName(ByVal WorkBookObject,ByVal TargetSheetName)
      Is_ExistSheetName = False
      Dim i
          '渡されたワークブックオブジェクトのシート数分ループします。
          For i = 1 To WorkBookObject.Sheets.Count
              If WorkBookObject.Sheets(i).Name = TargetSheetName Then
                  Is_ExistSheetName = True
                  Exit For
              End If
          Next
  End Function

 

ちょっとした処理の解説

上記のサンプルプログラムでは、冒頭で「Excel.Application」オブジェクトをCreateObjectで生成します。
Excel.Applicationオブジェクトを生成することで、外部プログラムからExcelに対する様々な操作をすることができます。

Excel.Applicationオブジェクトの詳しい仕様や、仕様できるメソッド、プロパティについては以下のMicrosoftのリファレンスサイトをご確認ください。

Application オブジェクト (Excel)
Application オブジェクト (Excel)
learn.microsoft.com

あと、一般的にVBAでシートをコピーや移動(Moveメソッド)する場合のコードをインターネットで調べると、以下のようなコードが紹介されています。

Worksheets("コピー元シート名").Copy Before := Worksheets("Sheet1")

ただ、今回紹介コードのように以下の構文でも同じように動作します。

Worksheets("コピー元シート名").Copy Worksheets("Sheet1")

コピー元シートオブジェクトのcopyメソッドの後に、スペースを空けて既存のシートオブジェクトを指定すると、Beforeと同じ挙動です。

Afterと同じように、指定したシートより後ろの位置を貼り付け先として指定する場合は、以下のコードのように第一引数は空白にして、第二引数で位置を指定します。

Worksheets("コピー元シート名").Copy , Worksheets("Sheet1")

尚、VBScriptではBeforeやAfterで位置を指定する構文には対応していないため、強制的に上記の第一引数、第二引数でコピー先の位置を指定することになります。
 
 

最後に

VBScriptやVBAで外部のExcelブックを操作するサンプルプログラムを紹介しました。

今回のサンプルプログラムでは、新規ブックを作成して、そのブックに対して別の大量にあるブックからシートをコピーして貼り付ける処理でしたが、他にも、外部ブック内のマクロを実行させるなど、「Excel.Application」オブジェクトを上手く活用させることで、様々な処理の自動化が可能になります。

是非色々試していただければと思います。

今回も読んでいただきましてありがとうございます。
それでは皆さまごきげんよう！

タイトルとURLをコピーしました