【エクセルVBA】シート毎にファイル分割するVBA

KINGKING007 2020年8月8日 1 分読み取り

あのー、Excelのシートを、一括で別ファイルに分割する方法ってありますか。

あー、標準機能では用意されていませんね。

そうですよねー。めんどうだなー。

では、マクロで解決しましょう！

Excelのシートを、一括で別ファイルに分割するマクロをご紹介します。
複数ファイルもまとめて処理可能です。

目次

マクロ機能が有効なExcelブック「.xlsm」を作成

Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方

コードを標準モジュールに貼り付け

標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方

標準モジュールを開いて、下記のコードを貼り付けて下さい。

コード

Sub シート一括分割()
 
    Application.ScreenUpdating = False
    
    Dim OpenFileName As Variant
    OpenFileName = Application.GetOpenFilename _
            ("EXCELファイル,*.xls*", MultiSelect:=True)
    
    If Not IsArray(OpenFileName) Then
        MsgBox "キャンセルされました。処理を終了します。": Exit Sub
    End If
  
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject
    
    Dim n As Long '選択したファイル数、処理を繰り返す
    
    For n = LBound(OpenFileName) To UBound(OpenFileName)
    
        Dim wb As Workbook
        Set wb = Workbooks.Open(OpenFileName(n))
        
        Dim strBaseName As String
        strBaseName = FSO.GetBaseName(wb.Name) '拡張子を除くファイル名を取得

Dim sh As Object  ' WorksheetまたはChart
        
        For Each sh In Worksheets
        If sh.Name <> "macro" Then
        sh.Copy
        
        'ファイル名& &シート名で同じ階層にExcel形式で保存する
        ActiveWorkbook.SaveAs _
        Filename:=wb.Path & "\" & strBaseName & " " & sh.Name, FileFormat:=xlWorkbookDefault
        
        ActiveWorkbook.Close SaveChanges:=False
        
        End If
        
        Next sh
        
        wb.Close SaveChanges:=False
        
        Set wb = Nothing '一時解放
    
    Next n
 
    Application.ScreenUpdating = True
 
    MsgBox "完了しました。処理を終了します。"
 
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

Sub シート一括分割()

Application.ScreenUpdating = False

Dim OpenFileName As Variant

OpenFileName = Application.GetOpenFilename _

("EXCELファイル,*.xls*", MultiSelect:=True)

If Not IsArray(OpenFileName) Then

MsgBox "キャンセルされました。処理を終了します。": Exit Sub

End If

Dim FSO As FileSystemObject

Set FSO = New FileSystemObject

Dim n As Long '選択したファイル数、処理を繰り返す

For n = LBound(OpenFileName) To UBound(OpenFileName)

Dim wb As Workbook

Set wb = Workbooks.Open(OpenFileName(n))

Dim strBaseName As String

strBaseName = FSO.GetBaseName(wb.Name) '拡張子を除くファイル名を取得

Dim sh As Object ' WorksheetまたはChart

For Each sh In Worksheets

If sh.Name <> "macro" Then

sh.Copy

'ファイル名& &シート名で同じ階層にExcel形式で保存する

ActiveWorkbook.SaveAs _

Filename:=wb.Path & "\" & strBaseName & " " & sh.Name, FileFormat:=xlWorkbookDefault

ActiveWorkbook.Close SaveChanges:=False

End If

Next sh

wb.Close SaveChanges:=False

Set wb = Nothing '一時解放

Next n

Application.ScreenUpdating = True

MsgBox "完了しました。処理を終了します。"

End Sub

Microsoft Scripting Runtimeを有効にする

Microsoft Scripting Runtimeを有効にする方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】Microsoft Scripting Runtimeを有効にする方法

マクロを実行

上記で作成したマクロファイル（ここでは「シート一括分割.xlsm」とファイル名を設定。）と、
マクロ実行テスト用のダミーデータとして、エクセルファイルを準備します。

※マクロ実行テスト用のダミーデータとして作成した、複数シートを含むエクセルファイル。

※マクロ実行テスト用のダミーデータとして作成した、複数シートを含むエクセルファイル。
シート名、「001、002、003」を含んでいます。

マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない（クリック不要の）場合もあります。

「開発」タブをクリックします。

「マクロ」をクリックします。

マクロ「シート一括分割」を選択、「実行」をクリックします。

「ファイルを開く」ダイアログが表示されるので、
シートを一括分割したい対象エクセルファイルを選択して、「開く」をクリックします。

ダイアログが表示されるので「OK」をクリックします。

マクロで選択したエクセルファイルの格納されているフォルダを開くと、
シートが一括分割されてExcelブックが作成されています。

完了です。

参考サイト

EXCEL 小技・テクニック集
EXCEL シート毎にファイル分割保存する方法／マクロ(VBA)で解決！

もりさんのプログラミング手帳
【ExcelVBA】複数のCSVファイルを一括でExcelファイルに変換する