Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

54398 / 76732

←次へ　｜　前へ→


	【27128】Re:オートフィルタで抽出したものを別シート...

Jaka - 05/7/29(金) 14:10 -


	引用なし

	パスワード

こんにちは。
ステップ実行して、動くように手直ししてみました。
こんな感じでいいのでしょうか？

Sub ITEM別抽出マクロ_1()
　　Dim itemmax As Integer, i As Integer, maxcol As Integer
　　Dim tbl As Range, tblR As Range
　　
　　Application.ScreenUpdating = False
　　With Sheets("メイン")
　　　　itemmax = WorksheetFunction.Max(.Range("a:a"))
　　　　' 最大のITEMナンバーの取得
　　　　maxcol = .Cells(9, 256).End(xlToLeft).Column
　　　　'最大列の取得
>　　　　'Set tbl = .Range("A9", .Range("A65536").End(xlUp))
　　　　　　　　　　　　　　'↓
　　　　 Set tbl = .Range("A10", .Range("A65536").End(xlUp))

　　　　'フィルターにかける範囲を設定
　　　　For i = 1 To itemmax
　　　　　　'１～最大ITEMナンバーまで繰り返し作業する
　　　　　　ActiveSheet.AutoFilterMode = False
　　　　　　'フィルターモードの取り消し
　　　　　　tbl.AutoFilter
　　　　　　'範囲をフィルター設定
　　　　　　'Sheets("" & i & "").Cells.Clear
　　　　　　tbl.AutoFilter field:=1, Criteria1:="" & i & ""
　　　　　　'目的のデータを抽出
　　　　　　Set tblR = .Range(.Cells(9, 1), .Cells(.Range("a65536").End(xlUp).Row, maxcol))

　　　　　　tblR.Copy Destination:=Sheets("" & i & "").Range("a3")
　　　　　　'それをそれぞれのシートにコピー

>　　　　　 'Cell.EntireColumn.AutoFit
　　　　　　　　'↓
　　　　　　Cells.EntireColumn.AutoFit
　　　　　　Rows("4:4").Select
　　　　　　Range(Selection, Selection.End(xlDown)).Select
　　　　　　Selection.RowHeight = 25
　　　　　　Range("B7").Select
　　　　　　ActiveWindow.Zoom = 75
　　　　　　Range("A1").Select
　　　　　　'セル列幅を整え　行高さ25、ズーム75%に設定
　　　
　　　　Next i

　　tbl.AutoFilter field:=1
　　End With
　　'追加↓
　　ActiveSheet.AutoFilterMode = False
　　Application.ScreenUpdating = True
End Sub

2 hits

▼

【27094】オートフィルタで抽出したものを別シート... RIKU 05/7/28(木) 20:37