软件:EXCEL
版本:2016
目前的资料如下：
编号 总公司 分公司 部门组别 姓名 性别 报名
1 A B F 甲 男 Y
2 A B F 乙 男 N
3 A B G 丙 女 Y
4 A C H 丁 女 Y
5 A C I 戊 男 Y
6 A D J 己 女 Y
7 A D K 庚 男 N
8 A E L 辛 女 Y
9 A E M 壬 男 N
想依分公司进行筛选后另存新档 (即将所有分公司存在同一个档案)
内容为
编号 总公司 分公司 部门组别 姓名 性别 报名
1 A B F 甲 男 Y
2 A B F 乙 男 N
3 A B G 丙 女 Y
存盘为B.xlsx
有参考精华区中的资料
Sub Macro1()
Dim rLastCell As Range
Dim strName As String
Dim lLoop As Long
Dim wbNew As Workbook
With ThisWorkbook.Sheets(1)
Set rLastCell = .Cells.Find(What:="*", After:=[A1], _
SearchDirection:=xlPrevious)
For lLoop = 2 To rLastCell.Row
Set wbNew = Workbooks.Add
.Range("1:1," & lLoop & ":" & lLoop).EntireRow.Copy _
Destination:=wbNew.Sheets(1).Range("A1")
wbNew.Close SaveChanges:=True, Filename:=ThisWorkbook.Path _
& Application.PathSeparator & .Cells(lLoop, 1) & ".xls"
Next lLoop
End With
End Sub
但筛选出来的都只有第一列，以及存成的档案都是.xls
所以想请问各位大大该怎么修改程式,让档案可以顺利筛选与存成.xlsx
谢谢