標題: [發問] 求助，如何用VBA把拆分工作表及存檔日期 [打印本頁]

---

作者: threelin    時間: 2012-4-22 22:43     標題: 求助，如何用VBA把拆分工作表及存檔日期

大家好，

請教大家，兩個問題

（1）工作薄中有a b c d e f g，共7個sheet，我只想拆出c e g這3個sheet為獨立的檔案，其他4個不拆分。

（2）存檔日期，成指定為sheet g 中，A1的數值(A1=20120408)。

請教大家，該如何修改下面的VBA，才能實現我想要的功能，感謝大家幫忙

Sub test()
    Dim sht As Worksheet, ipath As String, iname As String
    ipath = ThisWorkbook.Path & "\"
    Application.ScreenUpdating = False
    For Each sht In ThisWorkbook.Worksheets
        iname = sht.Name
        sht.Copy
        With ActiveWorkbook
  .SaveAs Filename:=ipath & iname & "  " & sht1.Range("a1") & ".xls"
          .Close
        End With
    Next
    Application.ScreenUpdating = True
End Sub

---

作者: Hsieh    時間: 2012-4-22 22:51

本帖最後由 Hsieh 於 2012-4-22 23:33 編輯

回復 1# threelin
直接轉譯成VBA

1. Sub ex()
   
2. sh = Array("c", "e", "g")
   
3. ipath = ThisWorkbook.Path & "\"
   
4. Sheets(sh).Copy
   
5. With ActiveWorkbook
   
6. .SaveAs ipath & Sheets("g").[A1] & ".xls"
   
7. .Close
   
8. End With
   
9. End Sub

複製代碼

---

作者: threelin    時間: 2012-4-22 23:09

回復 2# Hsieh


    感謝Hsieh 版主。

我執行後，出現錯誤的小視窗，視窗的代號400，請教您是什麼原因，謝謝。

---

作者: register313    時間: 2012-4-22 23:25

回復 3# threelin

1. Sub ex()
   
2. sh = Array("c", "e", "g")
   
3. ipath = ThisWorkbook.Path & "\"
   
4. Sheets(sh).Copy
   
5. With ActiveWorkbook
   
6. .SaveAs ipath & Sheets("g").[A1] & ".xls"
   
7. .Close
   
8. End With
   
9. End Sub

複製代碼

修正2處,試試看
再有問題,要提供EXCEL壓縮檔

---

作者: threelin    時間: 2012-4-22 23:44

回復 2# Hsieh


    Hsieh 版主

    剛才的錯誤，我發現是我A1的數值沒打所造成的。

    我又重新執行了一次，但不是我需要的結果。

     我想要c、e、g三個工作表變成三個獨立的檔案， 檔名分別為 c 20120408.xls、e 20120408.xls、 g 20120408.xls

     再麻煩您幫忙，謝謝您。

---

作者: Hsieh    時間: 2012-4-23 00:10

回復 5# threelin

1. Sub ex()
   
2. n = Sheets("g").[A1]
   
3. sht = Array("c", "e", "g")
   
4. ipath = ThisWorkbook.Path & "\"
   
5. For Each sh In Sheets(sht)
   
6. sh.Copy
   
7. With ActiveWorkbook
   
8. fs = ipath & sh.Name & n & ".xls"
   
9. .SaveAs fs
   
10. .Close
    
11. End With
    
12. Next
    
13. End Sub

複製代碼

---

作者: bbojj    時間: 2012-4-23 00:23

本帖最後由 bbojj 於 2012-4-23 00:28 編輯

感謝版主
又多學了一些東西！

有個問題請教
設定 ipath=ThisWorkBook.path 是要讓 Copy出來的檔案與原檔在同一個資料夾底下嗎？
謝謝回答!

---

作者: threelin    時間: 2012-4-23 00:32

回復 6# Hsieh


    感謝版主細心及耐心的回答，可以用了，謝謝您。:)


    我把 08.fs = ipath & sh.Name & n & ".xls"   改成 08.fs = n & ipath & sh.Name &  ".xls"

    跳出錯誤，不知道是為什麼？

---

作者: Hsieh    時間: 2012-4-23 10:05

回復 8# threelin
ipath=Thisworkbook.Path & "\"
ipath是存檔位置
例如:Thisworkbook是存放在D:\TEMP
ipath就是"D:\TEMP\"
若n="e"
n &  ipath就成了"eD:\TEMP\"

所以n &  ipath這樣是找不到這個資料夾，所以出錯

---

作者: threelin    時間: 2012-4-23 13:08

回復 9# Hsieh


    謝謝版主您的回覆，我明白了。

　請教您，如果是把日期放在前面，是不是不可行，還是有其它的寫法？

---

作者: register313    時間: 2012-4-23 13:11

本帖最後由 register313 於 2012-4-23 13:12 編輯

回復 10# threelin


fs = ipath & n & sh.Name &  ".xls"

---

作者: threelin    時間: 2012-4-23 15:12

回復 11# register313

感謝register313 的幫忙。:)

剛才又發現一個問題，c 、e 、g三個表的資料是連結到其它表格的
拆成獨立檔案後，在c 、e 、g　三個表中，儲存格還是會有連結路徑

請教您
該如何修改成，先將c 、e 、g　三個表中的數值選擇性貼上後，再拆分成三個獨立檔案，謝謝您。

---

作者: register313    時間: 2012-4-23 18:26

回復 12# threelin

1. Sub ex()
   
2. n = Sheets("g").[A1]
   
3. sht = Array("c", "e", "g")
   
4. ipath = ThisWorkbook.Path & "\"
   
5. For Each sh In Sheets(sht)
   
6. sh.Copy
   
7. With ActiveWorkbook
   
8. Cells.Copy
   
9. Cells.PasteSpecial Paste:=xlPasteValues
   
10. fs = ipath & n & sh.Name & ".xls"
    
11. .SaveAs fs
    
12. .Close
    
13. End With
    
14. Next
    
15. End Sub

複製代碼

---

作者: p6703    時間: 2012-4-23 23:50

看到各位先進的詳細解答,讓小弟受益不少,真是太感謝了^^

---

作者: threelin    時間: 2012-4-24 11:10

回復 13# register313


    感謝register313大大，已經可以了，謝謝您。;P

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)