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
      '1〜最大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 質問
【27128】Re:オートフィルタで抽出したものを別シー... Jaka 05/7/29(金) 14:10 回答
【27147】新たな問題点3-5 RIKU 05/7/30(土) 4:21 質問
【27148】Re:オートフィルタで抽出したものを別シー... RIKU 05/7/30(土) 5:03 質問
【27190】Re:オートフィルタで抽出したものを別シー... Jaka 05/8/1(月) 14:44 発言

54398 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free