| |
AdvancedFilterメソッドを使って作業列にユニーク値を取り出し、それをLoopしてはどうでしょうか。
Dim ws As Worksheet
Dim rs As Range
Dim r As Range
Set ws = ActiveSheet
ws.AutoFilterMode = False
If ws.Range("D65536").End(xlUp).Row = 1 Then Exit Sub
Set rs = ws.Range("A1").CurrentRegion
rs.Columns("D").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws.Range("IV1"), _
Unique:=True
For Each r In ws.Range("IV2", ws.Range("IV65536").End(xlUp))
With Worksheets.Add(Sheets(1))
rs.AutoFilter field:=4, Criteria1:=r.Value
rs.Copy Destination:=.Range("A1")
On Error Resume Next
.Name = r.Value
On Error GoTo 0
End With
Next
ws.AutoFilterMode = False
ws.Columns("IV").Delete
|
|
n
- 13/1/15(火) 23:20 -
