Hey Leon,

Try this, I beleve this is what your looking for. Select the Vendor Name in
Column "D" and run this macro. I use a command  button. Hope this helps.

 Rick , (Fbks, Ak)

Option Explicit

Sub NewNameSheet()

Dim main As Worksheet, wksNew As Worksheet
Dim lrc As Long
Dim Name As String
Dim ishCt As Integer        '' sheet count
Dim lnewRc As Long          '' row postion on new sheet

Set main = Worksheets("sheet1") '' main sheet
lrc = 6                            '' start row
Name = ActiveCell.Value

ishCt = Sheets.Count                        '' get number of worksheets
Worksheets.Add after:=Sheets(ishCt)              '' add new sheet
Worksheets.Item(ishCt + 1).Name = Name      '' rename sheet
Set wksNew = Worksheets(Name)

main.Range("B5:F5").Copy wksNew.Range("B5:F5")  '' copy header

lnewRc = 6                                  '' beginning row for records

'' search for Name of vendor, then Copy data to new sheet

Do Until IsEmpty(main.Cells(lrc, "D"))
  If main.Cells(lrc, "D") = Name Then
        '' Copy Vendor Data, & paste to new sheet
        main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" & lnewRc &
":F" & lnewRc)
        lnewRc = lnewRc + 1
  End If
 lrc = lrc + 1         '' next row to search
Loop

End Sub