Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8998 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【29857】フィルタで抽出したものを・・・ えりおっと 05/10/14(金) 23:11 質問[未読]
【29863】Re:フィルタで抽出したものを・・・ ponpon 05/10/15(土) 0:39 発言[未読]
【29865】Re:フィルタで抽出したものを・・・ Mi 05/10/15(土) 7:33 回答[未読]
【29900】Re:フィルタで抽出したものを・・・ えりおっと 05/10/15(土) 22:33 お礼[未読]
【29857】フィルタで抽出したものを・・・
質問  えりおっと  - 05/10/14(金) 23:11 -
引用なし
パスワード
   オートフィルタで抽出すると
１０パターンくらいに分かれるデータがあるとします−

抽出されたパターンごとに自動的にシート別に貼り付ける・・・
このようなことをしたいのですが、
どなたか教えていただけますでしょうか？？

あと、一つのブックにある複数シートを
シート別に保存したいのですが、
こんなことも可能でしょうか？？

２つがわかれば当方大変大変助かります。
どうぞご回答お願い致します（_ _)
【29863】Re:フィルタで抽出したものを・・・
発言  ponpon  - 05/10/15(土) 0:39 -
引用なし
パスワード
   こんばんは。

>１０パターンくらいに分かれるデータがあるとします−

シ−トレイアウト、どんなデータがあるのか。
１０パターンとは？

>あと、一つのブックにある複数シートを
>シート別に保存したいのですが

マクロの記録は、されましたか？
後は、for　each　〜　nextでワークシートを回せばいかがでしょう？
【29865】Re:フィルタで抽出したものを・・・
回答  Mi  - 05/10/15(土) 7:33 -
引用なし
パスワード
   ▼えりおっと さん：

おはようございます。
以下の条件で作成しました。

シートは２行目が項目の行
フィルターは２列目(つまりB2です）
仕上がりのシートの大きさが分からないので、Z3000のセルのところで
フィルター結果を一旦表示させています。
A1とA4を作業用に使用しています。
標準のモジュールに貼り付けて試してみてください。


Sub Filterとsheet作成()

'　　Application.ScreenUpdating = False

　　Dim i As Integer
　　Dim ST_Name As String
　　　

　　Range("Z3000").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.ClearContents
　　
　　Sheets("AA").Select
　　　　Range("B2", Cells(65536, 2).End(xlUp)).Select
　　　　Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　　　Selection.SpecialCells(xlCellTypeVisible).Copy
　　　　Range("Z3000").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　
　　
　　Range("A1").Select
　
　　For i = Cells(65536, 26).End(xlUp).Row To 3001 Step -1
　　Range("E1") = Cells(i, 26).Value
　　ST_Name = Range("E1")
　
　　del_sheet ST_Name
　
　　Sheets("AA").Activate
　　Range("A2").AutoFilter Field:=2, Criteria1:=Range("E1")
　　Range("A2").CurrentRegion.Select
　　Selection.Copy
　　Sheets.Add after:=Sheets(Sheets.Count)

　　Sheets(Sheets.Count).Name = ST_Name
　　　
　　Range("A1") = ST_Name
　
　　Range("A2").Select
　　ActiveSheet.Paste
　　
　　Application.CutCopyMode = False
　　Sheets("AA").Activate
　　Selection.AutoFilter

　　Next　　

　　Range("A1").Select
　　
'　　Application.ScreenUpdating = True

End Sub

Sub del_sheet(ST_Name As String)
　　On Error Resume Next
　　Application.DisplayAlerts = False
　　Sheets(ST_Name).Delete
　　On Error GoTo 0
　　Application.DisplayAlerts = True

End Sub

とりあえずこれで大体のことが出来ていると思いますが･･･
また識者から知恵を拝借してください・・・
【29900】Re:フィルタで抽出したものを・・・
お礼  えりおっと  - 05/10/15(土) 22:33 -
引用なし
パスワード
   　Mi さん　PONPONさん

貴重なお答え大変参考になりました。
他のレスも参考にし、なんとか出来たような感じです。
ありがとうございました！
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8998 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free