28本目 シートをブックに分割

VBA100本ノック 28本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ

---

問題

#VBA100本ノック 28本目
個人別のシートを個人別のブックに分けまます。
シート名は”部署_氏名”です。
ブックと同一フォルダに”部署”フォルダを作成し、シート名をブック名にして出力してください。
“部署1_日本 太郎”→”部署1″フォルダに”部署1_日本 太郎.xlsx”
※再実行を考慮
※対象ブックは任意

少しわかりづらい部分がありそうなので補足します。
“部署_氏名”
この「部署」はいくつもあります。
個人別のブックを部署ごとに振り分けて出力してください。

解答

Sub test1()

    Dim tmp As Variant
    Dim i As Long, j As Long
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        tmp = Split(Cells(i, 1), "_")
        For j = 0 To UBound(tmp)
            Cells(i, j + 2) = tmp(j)
        Next
    Next

End Sub


Sub test2()

    ActiveSheet.Copy
    ActiveWorkbook.SaveAs "保存したいパスと名前…"

End Sub

Sub ノック28本目まとめ()

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    
    Application.DisplayAlerts = False
    
    Dim fso As New Scripting.FileSystemObject
    Dim tmp As Variant
    Dim sPath As String
    For Each ws In wb.Sheets
            
        ws.Visible = 1
        If ws.Name Like "*_*" Then
            tmp = Split(ws.Name, "_")
            sPath = wb.Path & "\" & tmp(0)
            If Not fso.FolderExists(sPath) Then
                fso.CreateFolder sPath
            End If
            ws.Copy
            ActiveWorkbook.SaveAs sPath & "\" & ws.Name & ".xlsx"
            ActiveWorkbook.Close
        End If
    Next
    
End Sub