| |
ありがとうございます。
参考になりました。
下記の要領でいけそうです。
-------------------------------------------
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
