【メモ】ド素人がファイル分割のVBAを何とかする

100を超の部からデータをもらい集約＆一定のキーでフィルタし各部に展開（エクセルファイルを添付してメール送信）しろ！だと…？
そんな作業は得意な人にやらせりゃいいでしょうに。えっ？データがデータなので触らせられない？いやいや、そこは割り切ってくださいよ。
…はい。分かりました。（困った。。どうしよう。）

ということで、ネットの拾い物をあれやこれやしてVBAで何とかしようというもの。
　
【やりたいこと】
①：特定のアドレスに届いたメールに添付されたエクセルファイルを一か所に保存
②：①で集めたエクセルファイル（特定フォーマット）を1つのブックにまとめる
③：②で作った集約後のブックを特定項目グループ化しそれぞれ別のブックで保存（たとえばA部、B部、C部…ってな感じ）
④：各部の担当者へ、③で作ったそれぞれのブックを添付してメール送信

【現状】
①②：何とかなった
③：本件
④：難しそうなので一旦放置


【やりたいこと③へ向けて】
・参考にさせていただいたサイト
　ヘルプの森さま　https://www.helpforest.com/excel/emv_sample/ex100010.htm
　※サンプルを置いていただいており大変助かった。というか無かったら諦めようと思っていた。



Sub Sample()


'１．名前の定義＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

    Dim MacroB      As Worksheet    'このブックのシート
    Dim Wb_Data     As Workbook     '分割元のブック
    Dim Datapath    As String       '分割元のブックのプルパス
    Dim Ws          As String       '分割元のシート名　※分割元のブック内である必要あり
    Dim Wb_new      As Workbook     '転記先のブック
    Dim SavePath    As String       '転記先のブックの保存先
    Dim C_Group     As String       '分割元シートでグループ化けする対象列
    Dim GroupName   As String       'グループ名　※ブック名にも使用
    Dim C_Copy      As String       '分割元データの右端列　※ここまでがコピー範囲右端となる
    Dim YMD         As String       '転記先のブックの保存名称における日付形式　※設定する場合のみ
    Dim T_Data      As Long         '分割元でデータの項目行
    Dim R_Data      As Integer      '分割対象の実データが始まる最初の行番号　※つまり項目行の一つ下
    Dim Ko          As Integer      'グループの件数
        
        
        
'２．下準備＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

    Application.ScreenUpdating = False       '実行中の画面更新を停止
    
     
            
'３．定義した名前に値をセット＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
        
  '①：シンプルにセル参照で決定されるもの

    Set MacroB = ThisWorkbook.Worksheets(1)  'MacroB（ワークシート）はこのブックの1番目のシートとする
        Datapath = Range("C11")
        Ws = Range("C12")                    'Ws（ワークシートの名称）はC12セルに記載した値とする
        T_Data = Range("C13")                'T_Data（項目行は）はC13セルに記載した値とする
        R_Data = T_Data + 1
        SavePath = Range("C14") & "\"        'PathはMacroB（ワークシート）のC14セルに記載したパスの末尾に\を足したものとする
        C_Group = Range("C15")               'C_GroupはMacroB（ワークシート）のC15セルに記載した値とする
        C_Copy = Range("C16")                'C_CopyはMacroB（ワークシート）のC16セルに記載した値とする
        YMD = Range("C17")                   'YMDはMacroB（ワークシート）のC17セルに記載した値とする


  '②：YMDの条件指定
        
        If YMD = "" Then                     'YMD（ブック保存時の日付表示形式）がブランクの場合
           YMD = ""                          '→そのまま（設定しない）
        Else                                 'YMD（ブック保存時の日付表示形式）がブランクでない場合
           YMD = Format(Date, YMD)           '→YMD（の値）を日付形式に変換する
        End If


  '③：Wb_Dataのセット　※パス指定したファイル（Datapath）を開きそれをWb_Dataとする

      '（1）Wb_Dataが既に開かれているかチェック

        Dim i     As Integer
        For i = 1 To Workbooks.Count
        If Datapath = Workbooks(i).FullName Then
           MsgBox "分割対象のファイルを閉じてから実行してください"
           Exit Sub
        End If
        Next i

      '（2）開かれていない場合は開く・値を設定

        Workbooks.Open Filename:=Datapath
        Set Wb_Data = ActiveWorkbook           'アクティブワークブックをWb_Dataとする
        
     
        
    '（追加）分割対象ブックを開かないと進まないエラーが有ったため開く処理を追加したもの
    '        ファイルの存在チェックは含めていないため、必ずファイル選択ダイアログを一緒につけておくこと
    '        If文は分割対象ファイルが既に開かれているか確認するもの（開いている場合停止）
    '        If文をはずしてもよいが、対象ファイルが開いておりかつ未保存の更新内容が有る場合、変更内容を破棄するか確認のメッセージが出る
   
    
    
'４．実際の分割処理＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

  '①：分割元ブック項目行のコピー・新規ブックの追加
  
    Do
        Wb_Data.Activate                                                            'Wb_Data（分割元のワークブック）をアクティブ状態にする
        Worksheets(Ws).Range(Cells(T_Data, 1), Cells(T_Data, C_Copy)).Copy          'Wsとしたワークシートの項目行（T_Data行目の１列目からから右端列（つまりC_Copy)までコピー
        Workbooks.Add                                                               '新たにブックを追加
        ActiveSheet.Paste Cells(1, 1)                                               '新規追加されたブックのセル(1,1)に貼り付け ※T_Dataとすることも可能
        Set Wb_new = ActiveWorkbook                                                 'アクティブなブック（つまり直前まで操作してた新たなブック）をWb_newとする
                
                
  '②：分割元ブックの指定列データで範囲を指定・データコピー
                           
        Wb_Data.Activate                                                'Wb_Data（分割元のワークブック）をアクティブ状態にする
        GroupName = Cells(R_Data, C_Group)                              'Groupname（文字列）は実データが始まる行）のグループ化したい列（C_Group）の値とする
        Ko = WorksheetFunction.CountIf(Columns(C_Group), GroupName)     'グループ化したい列（C_Group）内にGroupname（文字列）の数何個か算出しそれをKoとする（＝あるグループの件数を算出）

        Range(Cells(R_Data, "A"), Cells(R_Data + Ko - 1, C_Copy)).Copy  '2行目(R_Data）A列目から「2行+Groupnameの数-1」までをコピー
        
        '【上記解説①】
          'R_Dataは当初項目行+1行目、Koは「"当初項目行+1行目"のグループ化したい列（C_group）に入力された値の個数」なので
          'R_Data + Ko - 1までを範囲指定することで、「グループ化したい列（C_group）に入力された値が現れる一番下の列」まで
          '指定したことになる。（-1が重要）
        
        '【上記解説②】
          'グループ化対象行で並べ替え（同一データが隣接している状態）しておく必要あり
          'Koは順序を問わずグループ化したい列にある同一のデータ個数をカウントしている一方、
          '「R_Data + Ko - 1まで」はあくまで上から○個の考え方。
          '→並び替えをしていない場合、正しい範囲（同一のデータが登録されている範囲）をコピーできない
             
        
  '③：分割後ブックに貼付・保存
        
        Wb_new.Activate                                                     'Wb_new(①で新規追加したブック）をアクティブ状態にする
        ActiveSheet.Paste Cells(2, 1)                                       'A2セルに貼り付け（1行目は①で既に項目行が存在している）
        
        Wb_new.SaveAs Filename:=SavePath & GroupName & "_" & YMD & ".xlsx"  '保存時の名称を指定
        Wb_new.Close                                                        'Wb_newを閉じる
            
                
  '④：②～③の繰り返し処理
                
        R_Data = R_Data + Ko                                            '直前のR_Data（初回であれば2(3.参照)）にKoを加えた数を次のR_Dataとする

         '【上記解説③】
          '当初はR_Data列目から実データが始まり、1回目はそこから、同一グループになる範囲を指定しコピペ
          '次のグループが何行目から始まるか考えると、「R_Data＋同一グループに属するデータの個数」行目になる
          'この処理により次グループのデータが現れる一番上の行を新たにR_Dataと設定しなおす
          '（コピー範囲の上辺の列が次のグループのデータが現れる最初の行となる）
          
                
    Loop While Cells(R_Data, C_Group) <> ""                             'グループ化したい列（C_group）のR_Data行がブランクとなるまで繰り返す
    

    Wb_Data.Close

       
    MsgBox "完了！"
                
    
    
    
    Application.ScreenUpdating = True


End Sub



いくつか分からない部分は残っているが、おおむねやりたいことは実現できそうな気配。
引き続きスーパード素人なりに頑張ろう。



（2021/2/13追記）
    '※※上記不明点※※
    '分割対象のブックを開いていないと上記部分でエラーとなり停止する
    '原因不明だが、分割対象のブックを開く処理を入れればいいか？

　→根本原因はよくわからないが分割対象のブックを開けば何とかなった
　　２．定義した名前に値をセット  Set MacroB = This～の直下に以下を追加

≪追加≫
'        F11セルに開くファイルのフルパスを入力したうえで処理
'        ファイルの存在チェックは含めていないため、必ずファイル選択ダイアログを一緒につけておくこと
'        If文は分割対象ファイルが既に開かれているか確認するもの（開いている場合停止）
'        If文をはずしてもよいが、対象ファイルが開いておりかつ未保存の更新内容が有る場合、変更内容を破棄するか確認のメッセージが出る

    Dim i As Integer
    Dim filepath As String
    filepath = Range("F11").Value '☆

    For i = 1 To Workbooks.Count
        If filepath = Workbooks(i).FullName Then
        MsgBox "分割対象のファイルを閉じてから実行してください"
        Exit Sub
        End If
    Next i
    Workbooks.Open Filename:=Range("F11").Value