同じシートにあるデータの分割で数式も反映させる

以下の応用編です。

同じシートにあるデータを別ブックに分割する 

別ブックに分割する例

• 分割の基準：A列（分類）
• データは分類順

対象はオレンジ色のデータです。

G列とH列に数式を設定してます。

• フィルター1：A列（分類）のAとB
• フィルター2：C列（購入先）がY店とZ店

上の図のフィルター実行後です。分類AとBは別のブックに保存します。

分割後のブック

分割対象の分類は、別シート「対象」に入力しています。

• A列（分類）：分割対象
• B列（ファイル名）：分割後のファイル名
• C列（行数）：データの行数です。分割後にＣ列に書き込みます。

もとのデータをピボットテーブルで集計すれば、元データと分割後のデータ数のチェックが可能です。

サンプルVBA（マクロ）

少し長いですが、単純な内容です。

サンプル

Sub sample()
    Const fPath As String = "F:\sample\"    ’ファイル分割後の保存先
    Dim i As Long
    Dim mWS As Worksheet        'もとのデータシート
    Dim tWS As Worksheet        '分割対象
    Dim nWB As Workbook         '新規ブック
    Dim nWS As Worksheet        '新規ブックのアクティブシート
    Dim rLowT As Long           '分割対象一覧のシートの最終行
    Dim rLowTmp As Long         '新規ブックに貼り付け後の最終行
    Dim bName As String         '抽出対象
    Dim wbName As String        'ブック保存名
   
    Application.ScreenUpdating = False
    
    Set mWS = Worksheets("一覧")
    Set tWS = Worksheets("対象")
    
    rLowT = tWS.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To rLowT
        bName = tWS.Cells(i, 1)
        wbName = tWS.Cells(i, 2)        
       　　 With Range("A1")
           　　 .AutoFilter 1, bName
           　　 .AutoFilter 3, "Z店", xlOr, "Y店"
       　　 End With            
        wbName = fPath & wbName       
        mWS.Range("A1").CurrentRegion.Copy      
        　 Set nWB = Workbooks.Add
        　 Set nWS = ActiveSheet        
         nWS.Paste            
            With nWS
                .Range("A1").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                rLowTmp = Cells(Rows.Count, 1).End(xlUp).Row
                .PageSetup.PrintArea = ("C1:H" & rLowTmp)
                .Range("A1").Select
            End With            
            With nWB
                .SaveAs Filename:=wbName
                .Close
            End With            
            tWS.Cells(i, 3) = rLowTmp - 1
    Next i    
    mWS.AutoFilterMode = False
    Application.ScreenUpdating = False
    MsgBox "データを分割しました。", vbInformation
End Sub

説明

1. シート「対象」に入力している分類名だけ処理を繰り返します。
2. シート「対象」に入力している分類名で、フィルター抽出しデータをコピーします。
3. 新しいブックを追加し、コピーしたデータを貼り付け、ブックに名前を付け閉じます。
4. シート「対象」に次の分類があれば、処理を繰り返します。なければくり返し処理は終了です。
5. 全データのあるブックのシート「一覧」のフィルター設定を解除します。

サンプル・印刷設定追加版

印刷設定を追加する場合は、印刷設定（PageSetup）を参照してください。

32行目～41行目を変更しました。

 With nWS
    .Range("A1").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
     rLowTmp = Cells(Rows.Count, 1).End(xlUp).Row
         With .PageSetup
              .Orientation = xlLandscape
              .Zoom = False
              .FitToPagesTall = False
              .FitToPagesWide = 1
              .PrintTitleRows = "$1:$1"
              .RightHeader = "&D"
              .LeftFooter = "&Z&F"
              .RightFooter = "&P/&N"
              .PrintArea = Range("C1:H" & rLowTmp).Address
         End With
      .Range("A1").Select
 End With