Excel VBA質問箱 IV

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

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


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

75039 / 76738

←次へ　｜　前へ→


	【6148】Re:部門ごとにシートを分けたいのですが

Jaka - 03/6/17(火) 17:29 -


	引用なし

	パスワード

こんにちは。
別解です。
データシートをアクティブとした状態で、かつデータシートの１行目は項目名として。

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

0 hits

▼

【6139】部門ごとにシートを分けたいのですが りん 03/6/17(火) 14:59