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

以下の応用編です。

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

目次

別ブックに分割する例

  • 分割の基準:A列(分類)
  • データは分類順

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

データ例

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

数式
ハイパーリンク
  • フィルター1:A列(分類)のAとB
  • フィルター2:C列(購入先)がY店とZ店
フィルター

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

フィルター実行後

分割後のブック

分割ブック

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

  • A列(分類):分割対象
  • B列(ファイル名):分割後のファイル名
  • C列(行数):データの行数です。分割後に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. 全データのあるブックのシート「一覧」のフィルター設定を解除します。
説明
  • 2行目:定数でファイル分割後の保存先パスを設定しています。
  • 3~11行目:変数変数設定しなくても実行できる個所もあり
  • 3行目「i」:くり返し処理(For~Next)の終了値
  • 13行目と45行目「 Application.ScreenUpdating」:画面更新の停止と開始
  • 15行目~16行目:変数にワークシートを設定
  • 18行目:分割対象のシート「対象」の最終行
  • 20行目と43行目「For~Next i」:分割対象のシート「対象」の2行目から最終行まで処理を繰り返す
  • 21行目~22行目:分割対象のシート「対象」の変数設定
  • 23行目~26行目:フィルターの条件設定
    引数の入力を省略しています
  • 28行目~37行目:データをコピーし新しいブックに貼り付けます
  • 35行目:印刷範囲の設定です
  • 38行目~41行目:ブックに名前を付け閉じます
  • 42行目:シート「対象」の列目にデータ数を設定します

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

印刷設定を追加する場合は、印刷設定(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   

目次