Excel VBA質問箱 IV

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

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


31829 / 76734 ←次へ | 前へ→

【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

3 hits

【50129】タイプ毎にシート分け Noritake 07/7/10(火) 16:59 質問
【50130】Re:タイプ毎にシート分け マクロマン 07/7/10(火) 17:17 発言
【50131】Re:タイプ毎にシート分け Hirofumi 07/7/10(火) 18:12 発言
【50148】Re:タイプ毎にシート分け Noritake 07/7/11(水) 16:36 お礼

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