Excel VBA質問箱 IV

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

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


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

31902 / 76807

←次へ　｜　前へ→


	【50148】Re:タイプ毎にシート分け

Noritake - 07/7/11(水) 16:36 -


	引用なし

	パスワード

ありがとうございます。
参考になりました。
下記の要領でいけそうです。

-------------------------------------------

Sub test()
Dim seru As Range
Dim i As Long
Dim presheet As String

i = 2

Application.ScreenUpdating = False

Set seru = Range("B2")

Do Until i = Range("A65536").End(xlUp).Row
　　 If Range("B" & i).Value <> seru.Value Then
　　　　n = Range("A65536").End(xlUp).Row
　　　　presheet = ActiveSheet.Name
　　　　Range("1:1,B" & i & ":B" & n).EntireRow.Copy
　　　　Sheets.Add
　　　　ActiveSheet.Paste
　　　　Sheets(presheet).Range("B" & i, "B" & n).EntireRow.Delete

　　　　Set seru = Range("B2")
　　　　i = 3
　　　　Else
　　　　i = i + 1
　　End If
Loop
Application.ScreenUpdating = True
End Sub

0 hits

▼

【50129】タイプ毎にシート分け Noritake 07/7/10(火) 16:59