VBA100本ノック 28本目：シートをブックに分割 - Infomentのブログ～Excel VBA奮闘記～

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

実際の業務でも、似たようなケースがあると思う。フォルダの存在確認は、
個人的にはFileSystemObjectのFolderExistsが直感的に理解しやすいので多用
している。読んで字のごとく、そのまんまだし。

ということで、作成したのがこちら。

Sub VBA_100Knock_028()
    ' Microsoft Scripting Runtime参照済み。
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
    ' ワークシートのループ用変数。
    Dim Ws As Worksheet
    ' 部署名。
    Dim PartName As String
    
    Dim FileName As String
    Dim FolderName As String
    Dim FolderPath As String
    Dim FilePath As String
    Dim Wb As Workbook
    
        Application.ScreenUpdating = False
        
        For Each Ws In Worksheets
            ' 「部署名_人の名前」のシート名でないと成立しない。
            PartName = Split(Ws.Name, "_")(0)
            FolderPath = ThisWorkbook.Path & "\" & PartName
            If Not FSO.FolderExists(FolderPath) Then
                MkDir FolderPath
            End If
            
            On Error Resume Next
            FileName = Split(Ws.Name, "_")(1)
            If Err.Number = 0 Then
                FilePath = FolderPath & "\" & FileName
                Ws.Copy
                Set Wb = ActiveWorkbook
                    Wb.SaveAs FilePath, xlOpenXMLWorkbook
                    Wb.Close False
            End If
            On Error GoTo 0
        Next
        
        Application.ScreenUpdating = True
End Sub