各位大大好
小妹為vba小白，用一點點程式基礎+錄製巨集+google，努力了4天還是搞不定
不知道問題在哪，只會跑一次就停了
想達到的：
把資料夾C:\Users\vi\Downloads\原始資料\內每個檔案的A1:E5儲存格資料，貼到篩選表(是固定的，已寫好12個工作表的陣列)，再分別以原檔案的名稱另存
C:\Users\vi\Downloads\原始資料\A02.csv →複製A1:E5儲存格 →到篩選表s2~s13的A2貼上 →到C:\Users\vi\Downloads\轉出資料\ 存檔為A02.xls →再重複這個過程
Sub 嘗試()
Dim mFile As String
For i = 1 To 200
mFile = Dir("C:\Users\viva\Downloads\原始資料\*.csv")
Next i
Do While mFile <> ""
Workbooks.Open Filename:="C:\Users\viva\Downloads\原始資料\" & mFile
mFile = Dir()
Range("A1:E5").Select
Selection.Copy
Windows("篩選表.xls").Activate
Sheets(Array("s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12", _
"s13")).Select
Sheets("s2").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
nName = Application.Workbooks(2).Name
Workbooks("篩選表.xls").SaveAs "C:\Users\viva\Downloads\轉出資料\" & nName & ".xls"
Workbooks.Close
Workbooks(2).Close
Loop
End Sub
已邀請的邦友 {{ invite_list.length }}/5
Sub aaa()
Dim mFile As String
mFile = Dir("C:\Users\vi\Downloads\原始資料\*.csv")
Workbooks.Open Filename:="C:\Users\vi\Downloads\對照.xlsx"
Do While mFile <> ""
Debug.Print mFile
Workbooks.Open Filename:="C:\Users\vi\Downloads\原始資料\" & mFile
Range("A1:E5").Select
Selection.Copy
Workbooks(2).Activate
Sheets(Array("s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12")).Select
Sheets("s2").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
nName = Application.Workbooks(3).Name
Workbooks(2).SaveAs "C:\Users\vi\Downloads\轉出資料\" & nName & ".xlsx"
Workbooks(3).Close
mFile = Dir
Loop
Workbooks(2).Close
End Sub
將“對照.xlsx”檔案那隻關閉這個設定並存檔
滑鼠移到 Excel 視窗上方的功能列，
依序點選【工具(T)】、【選項(O)】、及【安全性】，
在『隱私選項』下面有一個核取方塊寫著『存檔時自檔案摘要資訊中移除個人資訊(R)』，
試著不要打勾，然後點選【確定】。
-2007路徑
檔案/選項/信任中心/信任中心設定/隱私選項/
取消勾選 存檔時自檔案摘要資訊中移除私人資訊
實測可用
思考流路
1.檔案1為vba主程式
檔案2為對照.xlsx
檔案3為x.csv
2.主程式執行
3.取得csv路徑
4.開啟對照.xlsx
5.開啟x.csv
6.do something
7.取得csv名稱
8.另存對照為x.csv.xlsx
9.關閉x.csv
10.回5
11.完成後關閉對照.xlsx
sk大
成功了~成功了~~
感動得亂七八糟
當下是摀著嘴、手抖、眼眶泛淚、驚喜交加
真的不敢相信，天阿
好開心阿~~~~~~~~~~~~~
來快樂地說說測試的細節
『存檔時自檔案摘要資訊中移除個人資訊(R)』原本就是沒打勾的
我想了想sk大所講的邏輯，把vba放一個空的xls當主程式，把要套用的格式放在對照.xls，跑起來速度更快了
好像沒講什麼，原諒小妹我現在整個興奮到升天
真的原本以為是for迴圈擺放位置的問題，沒想到壓根問題不在那
感恩大大，讚頌大大，
繼續來參悟一下思考卡住的地方
太開心了
這幾天我把新舊兩隻程式對照著看，試著理清思路，也嘗試改寫
問題就像sk大大說過的：「VBA沒辦法幫自己另存檔再繼續執行」
即使是不關掉它也沒辦法繼續當Workbooks(1)
不知道這是不是VBA本身的限制
想起幾天前就是硬要寫在一張表、鑽進死胡同，感到有點羞
感想：寫程式，能達到目的，總比寫不出來好，思路要靈活
但對比週一寫到生無可戀的自己，此刻就像重新活過來一樣
再次謝謝兩位大大的指導
試試看
會不會顯示出所有 csv 檔名
會的話
再把你原來那些 code
填進去
Sub Macro1()
Dim mFile As String
mFile = Dir("C:\Users\viva\Downloads\原始資料\*.csv")
Do While mFile <> ""
Debug.Print mFile
'=======================
'要做的事寫在這裡
'=======================
mFile = Dir
Loop
End Sub
大大您好
試了一下，沒有顯示任何東西(還是說它應該顯示在哪邊??)，看起來xls沒有在動
填入code後，還是只有跑一次
謝謝
應該顯示在下圖下方的位置
(我用 *.jpg 測試，出現 *.jpg 檔名)
如果沒有顯示
就是路徑/檔名不對，或是程式寫錯
大大您好
有的，即時運算視窗叫出來，執行巨集有顯示出所有csv檔名，
把code貼上去後，只有轉了一個檔案出來
謝謝
執行巨集有顯示出所有csv檔名
我提供的程式只解決這個問題
剩下的部份
建議你自己按 F8 (逐行執行) 鍵一步一步執行
看看是那一段有問題
海綿大大的程式沒問題喔，我看了一下是你執行的思考流路有問題
Workbooks("篩選表.xls").SaveAs "C:\Users\viva\Downloads\轉出資料\" & nName & ".xls"
' 另外這邊另存的新檔名稱會是nName.xls.xls
Workbooks.Close
Workbooks(2).Close
這邊有問題
首先你執行ＶＢＡ的表單是？？？
如果是篩選表，VBA沒辦法幫自己令另存檔
然後把第一張表跟第二張關掉
這邊有產生一個問題如果你的表單只有2張都關光了誰做事？
所以他只跑一次
建議先把while拿掉，一條一條跑過一次沒問題再加上while
海綿大大 謝謝
正在努力中
sk大大
剛剛逐行跑後，我也發現了這個很ㄎㄧㄤ狀況 
因此把原本程式碼內有"篩選表.xls"的，都改成Workbooks(1)
然後最後面只關閉Workbooks(2).Close，Workbooks(1)只存檔而不關
好的，我試試把while先拿掉，一加進for就整個怪怪的
謝謝
把while先拿掉後，整個程式是沒有問題的
跑第二次，檔案仍是開第一個，不會開第二個
阿阿...迴圈，弄了4天還是卡在這
能幫上忙就好了，哈哈哈
最後還有一個問題saveAs完之後狀態列上的篩選表.xls變成x.xls了第二輪也沒有篩選表.xls可以選中了
能幫上忙就好了，哈哈哈
最後還有一個問題saveAs完之後狀態列上的篩選表.xls變成x.xls了第二輪也沒有篩選表.xls可以選中了
佔了一格隨便打點什麼好了。
1.excel VBA腳本
2.然後去開啟篩選表
3.開啟csv
4.do something
5.另存篩選表
6.關閉另存的篩選表
7.關閉csv
8.回2
建議流路設計（只是建議）
手機怪怪的發了二次XD
sk大
我是以不關閉的Workbooks(1).Activate用來當底，只需反覆貼上不同資料另存，
真的不知道問題出在哪....到底為什麼不能持續往下開資料夾內檔案運作.....
你可以把，最新版的程式碼貼上來看看
sk大
目前程式長這樣
Sub Macro1()
Dim mFile As String
mFile = Dir("C:\Users\vi\Downloads\原始資料\*.csv")
Do While mFile <> ""
Debug.Print mFile
Workbooks.Open Filename:="C:\Users\vi\Downloads\原始資料\" & mFile
mFile = Dir()
Range("A1:E5").Select
Selection.Copy
Workbooks(1).Activate
Sheets(Array("s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12", _
"s12")).Select
Sheets("s2").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
nName = Application.Workbooks(2).Name
Workbooks(1).SaveAs "C:\Users\vi\Downloads\轉出資料\" & nName & ".xls"
Workbooks(2).Close
mFile = Dir
Loop
End Sub
這邊不容易讀發到下面
iThome鐵人賽
看影片追技術