Excel VBA質問箱 IV

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

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


13302 / 13646 ツリー ←次へ | 前へ→

【6079】オートフィルター タイムレンジャー 03/6/16(月) 8:08 質問

【6079】オートフィルター
質問  タイムレンジャー  - 03/6/16(月) 8:08 -

引用なし
パスワード
   現在、下記のにあるコードで集計シートからデータを転記していますが、この方法ですと、不都合があり、次の方法に変更したいのでご教授宜しく御願い致します。

変更方法:新規シートを挿入せずに最初に決めておいた項目ごとのシート(sheet1等)      に転記し、最終行にtotalを表示する。(項目は多数ありますが今のところ
     5項目で実施しようと思いますですので、sheetが5枚でそのsheetに各項目      を集計シートから転記して最終行にtotalを表示します。

Sub リストごとに転記()
  Application.ScreenUpdating = False
  
  Set motoRng = Range("B4:E17") 'オートフィルターをかけたい範囲
  myfld = 1           'オートフィルタをかけたい列番号
  mykey = 1
  
  Set criRng = Range("G5:G10")  '抽出項目が入力されているセル範囲
  
  
  For Each tmpRng In criRng
    motoRng.AutoFilter myfld, tmpRng
   
      
    'フィルタをかける
      Set tmpsht = Sheets.Add(after:=Sheets(Sheets.Count))
    '新規シート挿入
    
    motoRng.Copy
    'フィルタをかけたままコピー。可視セルのみがコピーされる
    
    With tmpsht
      .Range("A1").PasteSpecial 8 'セル幅転記 ※Excel97では使えません
      .Range("A1").PasteSpecial xlPasteAll  'すべて転記
   End With
  Next
  
  Application.Goto motoRng     '元のシート・セルを選択
  ActiveSheet.ShowAllData      'フィルタ解除
  
   MsgBox "転記が終了しました。"
 
End Sub

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