you can use advancedfilter
Option Explicit
Sub test()
Dim ws As Worksheet
Dim r As Range
Dim c As Range
Dim wb As Workbook
Set ws = Sheets("All Suppliers")
Set r = ws.Range("a18", Range("a" & Rows.Count).End(xlUp)).Resize(, 12)
Set c = ws.Range("o1")
r.Columns("c").AdvancedFilter xlFilterCopy, , c, True
c.Offset(, 1).Value = r.Range("L1").Value
c.Offset(1, 1).Value = "No"
Set wb = Workbooks.Add(xlWBATWorksheet)
Do While c.Offset(1).Value <> ""
With wb.Worksheets.Add
.Name = c.Offset(1).Value
r.Range("b1:e1,k1").Copy .Range("a1")
r.AdvancedFilter xlFilterCopy, c.Resize(2, 2), .Range("a1:e1")
End With
c.Offset(1).Delete xlShiftUp
Loop
c.Resize(2, 2).ClearContents
Application.DisplayAlerts = False
wb.Sheets(wb.Sheets.Count).Delete
Application.DisplayAlerts = True
End Sub
マナ