集計したファイルを分割したい

質問

あるエクセルファイルに集計を加え、集計した結果をファイル内のある列の値で別ファイルに分割したい場合どの様なvbeを書けばよろしいでしょうか？
サンプルファイルでいいますと、集計はN列の伝票番号を基準にL列：原価計　M列：売価計をそれぞれ合計額を集計し、その集計結果を元にG列：店舗の値（1~15)でファイルを分割保存する事が目的です。　ちなみに行数は毎回変わります。（1500行前後になります。）
毎月月末にこの作業をしますが、非常に限られた時間でスピーディに完了しなくてはならず手作業ですとミスが起こり困っております。　どなたかご教示願います。

回答No.4

SI299792 · ベストアンサー

すみません、間違いました。
　　RowT = [N1].End(xlDown).Row
　　Range("A1:N" & RowT).Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(12, 13) _
　　　　, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
を入れて下さい。

お礼

目指していた形になりました。　助かりました。　何度もありがとうございました。

回答No.3

SI299792

サンプルデータは、アウトラインの小計機能を使って、伝票番号別で原価計　売価計の合計額の計算がありました。この状態で動かせば、出力ファイルに小計が出力されるはずです。
てっきりこの状態で動かすものと思っていました。この状態で動かすことを前提に作ったので、集計をせずに動かせば、最後の店舗が出力されないという障害が発生します。
もし、いちいち小計を付けるのが面倒なら、プログラムの最初（Dim の下）に
　　[A:N].Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(12, 13) _
　　　　, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
を入れて下さい。
終了後に、小計が削除された状態になっていてほしいのなら、プログラムの最後（End Sub の上）に
　　[A:N].RemoveSubtotal
を入れて下さい。

回答No.2

imogasi

仕事のことを、無料の質問コーナーに丸投げしているので、答える気がしなかった。
また内容も核心部分は、簡単ではないか、と思った。
ーー
方法は２つぐらい思い付く。
（１）支店番号でフィルターして、抽出されたデータをコピーして（可視セルだけを）他ブックの他シートに貼り付ける。
その作業をＶＢＡで支店分だけ繰り返す。
（２）コピーする範囲の行的な、Ｆｒｏｍ－Ｔｏについて
番号の変化した行の１行前までをコピーして他ブックの他シートに
貼り付け
上の行から支店番号の変化を判別の処理していって、スタート行（Ｆｒｏｍ）は初めが第２行から、終わり（Ｔｏ）は支店番号の変わった行の直前の行。次のスタートは変わった行からという風にコピーする範囲を繰り返す。
＃１の回答はたぶんこの方式かな？
集計部分は、分断後新たに算出すべきかもしれない。
ーー
＞vbeを書けばよろしいでしょうか
ＶＢＥはエディターのことで、ＶＢＡのコードというべき。
このそれを混用するレベルでは、本件は（ＶＢＡで処理することが必須かと思うが）、ＶＢＡでは無理かと。丸投げか。
ーー
質問の表を見ると、しっかりとした表を作っている。専門業者かシステム担当が作ったのか。専門家がいるのでは。その人に頼むべき。
各支店に渡すとして、紙でなくて、メイル通信かＵＳＢ発送か。
ＵＳＢに分ける場合などは、取り外しなど、ＶＢＡの経験が必要のような気がする。

回答No.1

SI299792

回答が付きませんね。
出力ファイルはどのような形式なのか・どこに出力するのかといった、必要な情報が無いからです。
私も上記の理由で答えなかったのですが、なかなか回答が付かないので、とりあえず作ったものを載せます。
ファイル形式は、入力ファイルと同じとしました。
出力先は、このファイルの入っていたフォルダ、ファイル名は店舗名としました。
最後に必ず「総計」があるものとしました。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Denpyo As String
　　Dim OldKey As String
　　Dim NowKey As String
　　Dim NewKey As String
　　Dim RowF As Long
　　Dim RowT As Long
'
　　Workbooks.Add
　　Application.ScreenUpdating = False
　　ThisWorkbook.ActiveSheet.[A1:N1].Copy [A1]
　　With ThisWorkbook.ActiveSheet
　　Denpyo = " "
　　RowF = 2
　　RowT = 2
'
　　Do While Denpyo > ""
　　　　NewKey = .Cells(RowT, "G")
'
　　　　If NewKey > "" Then
　　　　　　NowKey = NewKey
　　　　End If
'
　　　　If OldKey > "" And OldKey <> NowKey Or Denpyo = "総計" Then
　　　　　　[A2:XFD1048576].Clear
　　　　　　.Range("A" & RowF & ":N" & RowT - 1).Copy [A2]
　　　　　　Application.DisplayAlerts = False
　　　　　　ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & OldKey
　　　　　　Application.DisplayAlerts = True
　　　　　　RowF = RowT
　　　　End If
'
　　　　OldKey = NowKey
　　　　RowT = RowT + 1
　　　　Denpyo = .Cells(RowT, "N")
　　　　DoEvents
　　Loop
　　End With
　　ActiveWorkbook.Close
End Sub
多分変更点があると思うのでお書きください。

補足

質問内容が至らなくて申し訳ございません。　追加しますと以下の条件があります。
(1)出力するファイルは原本と同じxlsx形式です。
(2)出力する場所は、原本と同じフォルダ内です。
(3)集計（合計）する箇所は、Ｎ列の伝票番号別でＬ:原価計　M:売価計の合計額の計算が必要です。（出力した店舗ファイルに伝票番号ごとの原価計、売価計の合計額の集計がある形にしたいです。）

よろしくお願い致します。

よろしくお願い致します。