Excel VBA質問箱 IV

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

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


75033 / 76732 ←次へ | 前へ→

【6148】Re:部門ごとにシートを分けたいのですが
回答  Jaka  - 03/6/17(火) 17:29 -

引用なし
パスワード
   こんにちは。
別解です。
データシートをアクティブとした状態で、かつデータシートの1行目は項目名として。

Sub bobo()
  Dim roe As Long, coe As Integer, DtSh As Worksheet
  Set DtSh = ActiveSheet
  roe = DtSh.Cells(Rows.Count, "D").End(xlUp).Row
  coe = DtSh.Cells(1, Columns.Count).End(xlToLeft).Column
  bumo = Array("CJ20", "CJ50", "CJ70")
  Application.ScreenUpdating = False
  For i = 0 To UBound(bumo)
    DtSh.Range("D1:D" & roe).AutoFilter Field:=1, Criteria1:=bumo(i)
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = bumo(i)
    DtSh.Rows(1).Copy Sheets(bumo(i)).Range("A1")
    DtSh.Range("A2", DtSh.Cells(roe, coe)).SpecialCells(xlCellTypeVisible).Copy Sheets(bumo(i)).Range("A2")
    DtSh.Range("A" & roe).AutoFilter
  Next
  Application.ScreenUpdating = True
End Sub
1 hits

【6139】部門ごとにシートを分けたいのですが りん 03/6/17(火) 14:59 質問
【6145】Re:部門ごとにシートを分けたいのですが パピー(PAPIー) 03/6/17(火) 16:24 回答
【6148】Re:部門ごとにシートを分けたいのですが Jaka 03/6/17(火) 17:29 回答
【6184】Re:部門ごとにシートを分けたいのですが りん 03/6/18(水) 13:46 質問
【6186】Re:部門ごとにシートを分けたいのですが Jaka 03/6/18(水) 14:24 回答
【6187】Re:部門ごとにシートを分けたいのですが りん 03/6/18(水) 14:37 お礼
【6188】Re:部門ごとにシートを分けたいのですが パピー(PAPIー) 03/6/18(水) 15:07 発言

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