EXCEL中以A列单元格中的数据为文件名，生成新excel文件，如何编写VBA？

有一EXCEL文件名“订单明细”，内容如下：
姓名 订单号 机型 单价
张三 13030101 华为 100
李四 13030103 三星 200
李四 13030105 HTC 150
张三 13030107 三星 200
张三 13030109 华为 100

按一个按钮可以自动生成以“张三”，“李四”命名的文件，内容分别是两者的订单明细，如下：
“张三.xls” 的内容：
姓名 订单号 机型 单价
张三 13030101 华为 100
张三 13030107 三星 200
张三 13030109 华为 100

“李四.xls”的内容：
姓名 订单号 机型 单价

李四 13030103 三星 200
李四 13030105 HTC 150

Sub AddNew()

'设置当前活动工作表
Set s = ThisWorkbook.ActiveSheet

'获取当前工作表行数
rc = s.Range("A1").CurrentRegion.Rows.Count
'初始化源文件行和列、新建文件的行、新建文件数
Dim r, c, b_r, b_count As Integer
b_count = 0

'初始化文件名
Dim f As String

'初始化程序结束标志
Dim sub_end As String
sub_end = "N"

Do While sub_end = "N"
f = "None"
'查找未保存的姓名
For r = 2 To rc
If s.Cells(r, 5).Value = "" Then
f = s.Cells(r, 1).Value
Exit For
End If
Next

If f = "None" Then Exit Do '没有未保存的人员信息
Set b = Workbooks.Add

'写标题
With b
For c = 1 To 4
.ActiveSheet.Cells(1, c).Value = s.Cells(1, c).Value
Next
End With

b_r = 2 '新建工作簿中的行

For r = 2 To rc
If s.Cells(r, 1).Value = f And s.Cells(r, 5) = "" Then
'写入一条数据
With b
For c = 1 To 4
.ActiveSheet.Cells(b_r, c).Value = s.Cells(r, c).Value
Next
End With
b_r = b_r + 1
s.Cells(r, 5).Value = "OK" '标记已经处理过的记录

End If

Next

If b_r = 2 Then
b.Close SaveChanges:=False '无数据传入，不保存关闭新建窗口
sub_end = "Y" '跳出循环，结束程序
Else
'保存文件至d盘根目录
b.SaveAs Filename:="d:\" + f + ".xls"
b.Close '关闭文件
b_count = b_count + 1
MsgBox "第" + CStr(b_count) + "个文件【d:\" + f + ".xls】已经保存成功！", vbOKOnly, "提示:"

End If
Loop

If b_count = 0 Then
MsgBox "没有任何文件生成！" + Chr(13) + "如果您需要重新生成文件，将工作簿中" + Chr(13) + "第五列[E]中的所有“OK”删除即可", vbOKOnly, "提示:"
Else
MsgBox "所有文件已经保存完毕，共创建了" + CStr(b_count) + "个文件！", vbOKOnly, "提示:"
End If
End Sub

你好！ 把文件发我邮箱，说清楚目的与要求。mfk1288@126.com 如有疑问，请追问。

这得用到VBA才行的，可以用字典，欢迎定制