エクセルを使っての出納帳から自動で科目別の表を作成したい

エクセル2013を使ってPTAの会計処理をしています。
予算書、出納帳、決算書、特に出納帳の科目を条件にしてSUMIF関数を使って決算に自動記入出来ました。
科目別の明細はオートフィルターを使ってコピペしていたのですが、科目数も多くなり(40を超えて)行数も多くなり(200行超えてます)、自動で出来ないかと思い、過去ログ等を頼りにVBAを書いてみたのですが、うまく動作しません。

出納帳の1行目に見出しを入れて、2行目から日々の入出金、最後に収入合計、支出合計、残額の行を設けてあります。
　　　Ａ　　Ｂ　　Ｃ　　　Ｄ　　Ｅ　　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ
１　月日　分類　小分類　Ｎｏ．　摘要　　　収入　　支出　　残高　　　科目
２　4/1　本部　　運営　　１　　前年度　100,000　　０　　100,000　前年度繰越金
３　4/2　委員会　事業　　２　　会議　　　　　0　　900　　99,100　会議費

　　　　　　　　　　　　　　　　合計　***,***　***,***　***､***
となっています(画面ではズレているでしょう)
このＩ列の科目毎に明細表を作りたいのです。

ここの過去ログで下記のようなVBAを見つけ、やってみました。
教えていた方の話では、
K列に「抽出条件の見出しと最初の科目名」
M列に「抽出条件の見出しと(抽出したい？)全科目名」
N列に「科目毎のシートの名称」
を記入して、と有った(実際の返答を列数を増やしました)ので、そのようにしました。

Sub FilterDataCopy()

Dim MyRow As Long 'G列の行を入れる変数

Application.ScreenUpdating = False
MyRow = 2

'まず前日の抽出データを全てクリア
Do Until Sheets("出納帳").Cells(MyRow, "M") = ""
Sheets(Sheets("出納帳").Cells(MyRow, "N").Text).Select
Cells.Select
Selection.ClearContents
MyRow = MyRow + 1
Loop

Sheets("出納帳").Activate
MyRow = 2
'抽出してコピー
Do Until Cells(MyRow, "M") = ""
Range("K2") = Cells(MyRow, "M")
Range("A2").CurrentRegion.AdvancedFilter xlFilterCopy, Range("K1:K2"), Sheets(Cells(MyRow, "N").Text).Range("A2")
MyRow = MyRow + 1
Loop

Application.ScreenUpdating = True

End Sub

これで動かしたところ、各タブに1行目の見出しは書き出される(タイトルを入れる都合でA2からにしています)のですが、その下の実際の入出金が記載されないのです。
どのように修正したら良いのか？お教えいただけますでしょうか？
修正ではなく、新規でも構いません。

本当は、各科目の最終行に合計を入れたいのですが、それは可能ならで構いません。(^^;)
それに印刷することを考えると、行数が少なく終わってしまうモノも有りますので、少ないシート数に出来たらうれしいですが、そのくらいはコピペ出来ると思いますので(^^;)
お知恵をいただけないでしょうか？

質問者からの補足コメント

• 

  アドバイスありがとうございます。時間の都合と試行錯誤で遅くなりましたm(__)m
  ピボットテーブル試してみました。「収入支出」が合計で表示されるのは良いのですが、他の「月日」や「分類」「摘要」等が1行で表示されません。
  私の設定の仕方が悪いのかと色々やってみたのですが、やればやるほど見づらくなってしまいました(^^;)

  No.2の回答に寄せられた補足コメントです。 補足日時：2016/04/28 19:03

• 

  さらなるアドバイスありがとうございます。時間の都合と試行錯誤で遅くなってしまいましたm(__)m
  修正をしてやったのですが、何も表示されませんでした。
  あ、教えていただいたコードの「データ」は実際に合わせて「出納帳」と修正しました。
  そこで、別に簡単な表を作り、動かしてみたのですが、そちらではちゃんと表示されました。
  表の違いは、行数が違うこととセルに記入された単語？そして空白セルの有り無しくらいなんですが･･･
  
  フィルターを手動でやったら、出来たのですが･･･(;´･ω･)

  No.3の回答に寄せられた補足コメントです。 補足日時：2016/04/28 19:17

• 

  再度ありがとうございます。
  私が勘違いしていたようです。(^^;)
  「手動でフィルターを掛けたら出来ました」というのは、単にその表にフィルターを
  掛けたことで、ご教示いただいたページの様にやってみたところ、1行目の「月、分類･･･」が表示されるだけでその下は何も表示されませんでした。
  行数が多いのか？(そんなことはないと思いますが)と思い、例題と同じ13行くらいを範囲指定してみましたが、1行目しか表示されません。
  例題の表と見比べても、当然違いが判りません。あえて言えば、こちらには空白セルが有るくらいでしょうか。
  なんか深みにハマってきました(;_;)

  No.5の回答に寄せられた補足コメントです。 補足日時：2016/04/29 12:52

• 

  ありがとうございます。
  
  「月、分類･･･」は質問に書いた元データ(出納帳というシート名)の
  　　　Ａ　　Ｂ　　Ｃ　　　Ｄ　　Ｅ　　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ
  １　月日　分類　小分類　Ｎｏ．　摘要　　　収入　　支出　　残高　　　科目
  この行のことです(^^;)
  マクロを実行して、表示されるのは
  　　　Ａ　　Ｂ　　Ｃ　　　Ｄ　　Ｅ　　　　Ｆ　　　Ｇ　　　Ｈ　　　　Ｉ
  １　　　　科目
  ２　　　（リスト表示される科目）
  ３
  ４
  ５　月日　分類　小分類　Ｎｏ．　摘要　　　収入　　支出　　残高　　　科目
  で、6行目からには何も表示されないんです。
  
  はい、シートを右クリックの「コード表示」から書き込んでます。

  No.6の回答に寄せられた補足コメントです。 補足日時：2016/04/29 15:11

• わざわざやっていただきありがとうございます。
  
  「マクロ実行中」とメッセージボックスが出ました!!
  
  でも、表示は1行目だけです。

  No.7の回答に寄せられた補足コメントです。 補足日時：2016/04/29 16:22

• 

  またありがとうございます。
  
  試しに選択したモノはちゃんとデータのあるやつです(^^;)
  そして、空白にすると、「全てのデータ」が表示されました。
  
  ちなみに、列はそのまま、行は13行、データは不規則な表でやってみたらちゃんと表示されたのですが、データを今回の表からコピペしたらダメでした。
  データ自体に問題が有るってことでしょうか？

  No.8の回答に寄せられた補足コメントです。 補足日時：2016/04/29 18:08

• 

  科目の列には空白は無いです。
  他の列には空白が有りますが。
  
  出納帳シートの表の科目を一つコピーして貼り付けしても、今までと同じで1行目だけの表示でした。

  No.9の回答に寄せられた補足コメントです。 補足日時：2016/04/29 19:08

No.1 ベストアンサー 回答者： hallo-2007 回答日時： 2016/04/21 20:25

質問に対する直接の回答でなくて失礼します。

１、各科目ごとに40枚のシートが必要ですか？
２、最終行に合計を入れると下の方で位置もバラバラですよ。
私であれば
１、データの抽出シートを1枚
　　K2に科目をドロップダウンリストから選択したら
　　希望の科目の明細が下に表示する。
２、合計金額は上部分の固定した位置に表示させる。

参考までに、先日回答したサイトを紹介しておきます。
https://oshiete.goo.ne.jp/qa/9249567.html
仮に、別シートに
　　　Ａ　　Ｂ　　Ｃ　　　Ｄ　　Ｅ　　　　Ｆ　　　Ｇ　　　Ｈ
1　　　　　科目　　　　　　　　　　　　　収入計　支出計
2　　　　　会議費　　　　　　　　　　　　
3
4
5　月日　分類　小分類　Ｎｏ．　摘要　　　収入　　支出　　残高

とB２に希望する科目（入力規則を設定して、ドロップダウンで選択）
シートモジュールを開いて
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Sheets("データ").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A5:H53"), Unique:=False
End If
End Sub

B2セルを変更するだけで、ご希望の科目の明細が6行目以下に表示されます。

シートを移動して希望する科目を探すより
ドロップダウンリストで探す方が楽ですよ。

この回答へのお礼

アドバイスありがとうございますm(__)m
１は表現が下手ですみません。
「各科目ごとに40枚のシート」ではなく、1科目は1枚です。
科目が40くらい有るので、1科目1シートで、Book全体で40シート位になってしまう、ということです。
２の「合計を上部で固定」ですが、帳面に記帳した際の見た目を重視してしまいました。
文字サイズ等を変更して、見やすいようにすればいけますね(^_^;)

ご教授いただいたコードを新規のシートのタブで右クリックして貼り付けました。
「データ」を「出納帳」に修正しました。
しかし、6行目以下に何も表示されないのですが・・・？？？

科目ごとにシートを作った方が良いと思ったのは、私ではない者(後任)が作業したときに、その方が印刷する際にコピペしやすいかなと思ったからなんです(^_^;)

表示されない点等、お分かりになりますでしょうか？

お礼日時：2016/04/22 01:32

No.9 回答者： hallo-2007 回答日時： 2016/04/29 18:57

>データを今回の表からコピペしたらダメでした。

例えば、科目のデータに　空白がとか何かが含まれているとかは？
科目の一つをコピー
Ｂ２セルに張り付けてみては如何？？

この回答へのお礼

出来ました!!
今日再度詳細を確認しました。
問題なく抽出できた(マクロが動いた)試しに作った表と実際に使いたい表と見比べてみました。すると、抽出条件にする「科目」が「科　目」でした。(;´･ω･)
今後引き継いでもらう方のことも考えて、ファイルを用意したいと思います。
親身にお付き合いいただき、本当にありがとうございました。

お礼日時：2016/04/30 11:21

No.8 回答者： hallo-2007 回答日時： 2016/04/29 17:29

＞「マクロ実行中」とメッセージボックスが出ました!!

と云う事でしたら
Sheets("出納帳").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A5:I5"), Unique:=False
は実行されていますが
Ｂ２セルに入力されている　科目に該当するデータが一件もないという事はないですよね。
もうひとつ試して
Ｂ２セルを空白にしたら全てが表示されると思うのですが

＞ご教示いただいたページの様にやってみたところ、1行目の「月、分類･･･」が表示され
＞るだけでその下は何も表示されませんでした。
フィルターオプションの操作を行っても希望のデータが抽出されないという事ですね。
まずは、ここをクリアする必要があるかも？？

No.7 回答者： hallo-2007 回答日時： 2016/04/29 15:47

こちらでも同じようなエクセルファイルを作成し実行しましたが

出来ました。
ちなみに
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
MsgBox "マクロ実行中"
Sheets("出納帳").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A5:I5"), Unique:=False
End If
End Sub
と途中にＭｓｇｂｏｘ　で表示する行を追加してみましたが

Ｂ２セルの内容を変更したら、　マクロ実行中　と　表示が出ますか？

No.6 回答者： hallo-2007 回答日時： 2016/04/29 14:16

今日は暇なのでお付き合いします。

現在のシートの状況を説明してもらえませんか
＞1行目の「月、分類･･･」が表示されるだけでその下は何も表示されませんでした。
先の例では
１行目、２行目に抽出の条件です。
元データに月という項目があるのでしょうか。

先に紹介したコードはシートモジュールに記載します。
シート名を右クリックして、コードの表示をクリック
ＶＢエディターが起動したら、そのシートのシートモジュールになります。

No.5 回答者： hallo-2007 回答日時： 2016/04/28 21:36

＞フィルターを手動でやったら、出来たのですが･･･(;´･ω･)

だったら
マクロの記録
フィルターを手動でやったら
記録の終了

これで作成されたコードと現在のコードの違いを確認しましょう

If Target.Address = "$B$2" Then
の部分で、Ｂ２セルの内容が変更されたら
実行するという事を指定したいますが

No.4 回答者： ママチャリ 回答日時： 2016/04/23 09:07

横から失礼します。

後任に引き継ぐのであれば、あまり凝らない方が良いかと・・・。
そこで、次のような手順ではいかがでしょうか？こうしておけば、手作業のコピペも楽だと思います。

①元シートをコピーして”明細”シートを作成します。以下、”明細”シートでの作業です。
②科目で並べ替えます。
③科目をキーに、小計を設定します。「グループ毎に改ページを挿入」にすれば、印刷時に改ページもできます。

この回答へのお礼

貴重なアドバイスありがとうございます。
そうですね、今後科目名が変わったり増えたり減ったりすることも有りえますので、マクロだと敷居が高いかもしれません(^^;)
私はこれで楽させてもらいます(爆)が、引き継ぐのは別にした方が良さそうです。
ありがとうございました。m(__)m

お礼日時：2016/04/30 11:25

No.3 回答者： hallo-2007 回答日時： 2016/04/22 19:49

NO1です。

＞しかし、6行目以下に何も表示されないのですが・・・？？？
すみませんでした。
CopyToRange:=Range("A5:H53"), Unique:=False
は
CopyToRange:=Range("A5:H5"), Unique:=False
ですね。
後はB2セルを変更することでVBAが実行されると思います。
フィルターオプションの機能ですが
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filte …
の辺りを参考に一度、手動で抽出してみてください。

No.2 回答者： CoalTar 回答日時： 2016/04/22 18:31

ピボットテーブル試してみましたか？

http://allabout.co.jp/gm/gc/297727/

出納長のシートにおいて
[Ctrl]+[F3]名前の定義
名前 : PT範囲_出納
参照範囲 : =$A$1:INDEX($I:$I,COUNTA($A:$A))

ピボットテーブルの範囲を
=PT範囲_出納
とすることでピボットテーブルの範囲が可変になり
ピボットテーブル更新時に計算してくれます。

とりあえず、科目を行フィールド
収入と支出をデータフィールド
「データ」となりますので列フィールドにドラッグ
とか 科目をページフィールドにドラッグする
とか 合計/支出 の金額のセルをダブルクリックしてみるなんてのも