[算表] VBA篩選後另存新檔

作者: ktll (浪跡天涯的旅人)   2020-08-24 22:16:28
軟體: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
謝謝
作者: soyoso (我是耀宗)   2020-08-24 22:27:00
副檔名要存為.xlsx,".xls"改為".xlsx"內文舉例來看分公司有排序的話巨集調整為 https://i.imgur.com/jcS2GdH.jpg或是 https://i.imgur.com/Eyoq1mK.jpg
作者: ktll (浪跡天涯的旅人)   2020-08-24 23:29:00
按照第二個方法 存檔時出現錯誤 https://imgur.com/L87cCJu另外想請問在複製貼上後 再加上自動調整欄寬與列高 要怎麼設定 謝謝
作者: soyoso (我是耀宗)   2020-08-25 00:05:00
測試沒問題 https://i.imgur.com/paCYh10.jpg是什麼錯誤訊息提供一下。另外並沒有按照我提供的第二方法,cnt = lLoop + cnt-1,我不是這麼寫的自動調整欄寬與列高,range.autofit
作者: ktll (浪跡天涯的旅人)   2020-08-25 00:13:00
錯誤訊息 https://imgur.com/RSYNfjA已改成 lLoop = lLoop + cnt - 1 謝謝
作者: soyoso (我是耀宗)   2020-08-25 00:18:00
cells(...,1)這裡數字的1打成英文小寫的L(l)嗎?如果是的話,可模擬 https://i.imgur.com/Z25e7PY.jpg 出該錯誤訊息
作者: ktll (浪跡天涯的旅人)   2020-08-25 00:26:00
原來是打錯 謝謝你! 另外剛剛持續執行後 存檔的檔未照分公司命名 反而照編號命名 這部分的話 需要怎麼修改呢?
作者: soyoso (我是耀宗)   2020-08-25 00:33:00
巨集所寫cells(...,1)的1就是以a欄編號做為檔名,分公司的話為3
作者: ktll (浪跡天涯的旅人)   2020-08-25 00:34:00
好的! 真的太感謝你了!

Links booklink

Contact Us: admin [ a t ] ucptt.com