[發問] VBA修改 : 複製有函數的工作表，並另存到新的工作簿 VBA

edmondsforum

小弟，有一個檔案叫做 "週、月報表.xlsm"
裡面有工作表分別為：週報表、工作進度 等兩個。
週報表裡面有個函數為 =sheetname ，這是為了我方便根據"工作進度"使用VLOOKUP 抓出數據。
所以我只要複製週報表，並另名為"第一週" 他就會去抓"工作進度"合乎的內容
因此，我參照版上寫了以下VBA

1. Sub test3()
   
2. 
   
3.     Dim I As Long
   
4.     Dim xWeek As Integer
   
5.     Dim xS As Worksheet
   
6.     Dim xPH$
   
7.     xPH = ThisWorkbook.Path & "\"
   
8.    
   
9.     On Error Resume Next
   
10.    
    
11.     Application.ScreenUpdating = False
    
12.    
    
13.     Set xS = Sheets("週報表")
    
14.         xWeek = InputBox("請輸入第""?""週")
    
15.             xS.Copy After:=Sheets(Sheets.Count)            
    
16.             ActiveSheet.Name = "第" & xWeek & "週"
    
17.                 Set xName = ActiveSheet
    
18.                     xName.Copy
    
19.                     
    
20.             Application.DisplayAlerts = False
    
21.             
    
22.                 With xName.UsedRange
    
23.                     .Value = .Value
    
24.                 End With                                                         
    
25. 
    
26.                 With ActiveWorkbook
    
27.                     ActiveSheet.Name = "第" & xWeek & "週"
    
28.                     .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
    
29.                     .Close
    
30.                 End With
    
31.                
    
32.     Application.ScreenUpdating = True
    
33.    
    
34. End Sub

複製代碼

主要目的就是可以讓我輸入第"幾"週，就會產生一個 第"幾"週 工作表，並先讓他跑一下函數後( 例：VLOOKUP..等)
然後以純貼上值的方式取代
所以寫這個

1.          
   
2.                     With xName.UsedRange
   
3.                     .Value = .Value
   
4.                     End With   

複製代碼

但是想把他另存到目前工作簿("週、月報表.xlsm")的旁邊(同資料夾下)
所以參考別人寫了

1.                
   
2.                    With ActiveWorkbook
   
3.                     ActiveSheet.Name = "第" & xWeek & "週"
   
4.                     .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
   
5.                     .Close
   
6.                   End With
   

複製代碼

但另存的檔案內容還是參照到"週報表"函數......甚至條件不足造成亂碼，
不知道怎麼把它寫成，另存之後也是以純貼上值的方式........
再請求各位大神指點迷津.....拜託了

edmondsforum

我補充說明一下
假設我複製成功後,且另存新的檔案
那麼原先舊的檔案不是會產生工作表嗎
他能移除嗎？
或者是有什麼方式
先複製根據名稱跑函數，然後直接產生到新的檔案並以純值方式貼上。
不會而外在舊的檔案產生新工作表
不知道這樣表達各位大神能了解嗎

n7822123

回復 1# edmondsforum

沒檔案測試........只能看你的程式在腦海中演練

不過確實讓我看到問題，你工作表copy的時候 還是有公式的

所以要調換順序，先寫

With xName.UsedRange
     .Value = .Value
End With

再寫

xName.Copy

去掉公式再複製工作表基本上就沒問題了


我補充說明一下
假設我複製成功後,且另存新的檔案
那麼原先舊的檔案不是會產生工作表嗎
他能移除嗎？

在 Application.ScreenUpdating = True 這行程式前面 寫刪除工作表，應該就可以了

xName.delete

如果執行有錯的話，請附上檔案來看看吧，我幾乎是盲寫的

n7822123

回復 3# n7822123


避免你看不懂我在講什麼，產生雞同鴨講，還是改給你，你測試看看

Sub test3()

    Dim I As Long
    Dim xWeek As Integer
    Dim xS As Worksheet
    Dim xPH$
    xPH = ThisWorkbook.Path & "\"
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xS = Sheets("週報表")
    xWeek = InputBox("請輸入第""?""週")
    xS.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "第" & xWeek & "週"
    Set xName = ActiveSheet
    With xName.UsedRange
        .Value = .Value
    End With
    xName.Copy
   With ActiveWorkbook
       ActiveSheet.Name = "第" & xWeek & "週"
      .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
      .Close
   End With
   xName.Delete
   Application.ScreenUpdating = True
   
End Sub

edmondsforum

回復 4# n7822123
抱歉果然真的沒檔案會讓人很難理解@@
請諒解，我再度述說一次
1.假設我執行VBA了，輸入週數了

下載 (19.74 KB)

2020-6-24 08:25

2.輸入3之後，會產生"第3周"，此時地這個檔案的第3週
事先根據第3週去跑VLOOKUP後，以純值貼上。

下載 (36.02 KB)

2020-6-24 08:25

3.這邊我提個問題，為什麼跑完之後，我這邊的"週報表"的公式 =SHEETNAME 都暫時會以第3週呈現?
但只要點兩下就會正常，有辦法讓他自動更新嗎?

4.接著2，跑完之後，同時檔案旁邊也會產生"第3週"的檔案，但是未開啟的(大大教我改寫的方式會使他同時開啟)
因為將來會有批量產生的問題

下載 (8.11 KB)

2020-6-24 08:25

5.然後我點開產生另一個檔案的"第三週" 仍然還是有公式存在

下載 (50.53 KB)

2020-6-24 08:26

6.以上就是我的問題，目前檔案裡面有三個程式碼

下載 (24.34 KB)

2020-6-24 08:26

"工作進度"目前使用的是 Create1 Create3
目前是以test3再跑，如果成功，會分別應用在 Create1 Create3
如果可以再請大大幫忙一起改寫.....一個獨立複製  一個是批量複製的

檔案供參考
TEST.zip (356.97 KB)

下載次數: 8

2020-6-24 08:36

jcchiang

回復 5# edmondsforum

With xName.UsedRange
                    .Value = .Value
End With
改為
With ActiveSheet.UsedRange
        .Value = .Value
End With

因為xName被設定為原檔案的Sheet了,所以是將原檔案的改為值

edmondsforum

回復 6# jcchiang
謝謝大大
改成這樣之後，後面在加一個 xName.Delete 確實能創造我要的
附上修改後的

1. Sub test3()
   
2. 
   
3.     Dim I As Long
   
4.     Dim xWeek As Integer
   
5.     Dim xS As Worksheet
   
6.     Dim xPH$
   
7.     xPH = ThisWorkbook.Path & "\"
   
8.    
   
9.     On Error Resume Next
   
10.    
    
11.     Application.ScreenUpdating = False
    
12.    
    
13.     Set xS = Sheets("週報表")
    
14.         xWeek = InputBox("請輸入第""?""週")
    
15.             xS.Copy After:=Sheets(Sheets.Count)
    
16.             ActiveSheet.Name = "第" & xWeek & "週"
    
17.                 Set xName = ActiveSheet
    
18.                     xName.Copy
    
19.                     
    
20.             Application.DisplayAlerts = False
    
21.             
    
22.                 With ActiveSheet.UsedRange
    
23.                     .Value = .Value
    
24.                 End With
    
25. 
    
26.                 With ActiveWorkbook
    
27.                     ActiveSheet.Name = "第" & xWeek & "週"
    
28.                     .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
    
29.                     .Close
    
30.                 End With
    
31.                
    
32.     xName.Delete
    
33.     Application.ScreenUpdating = True
    
34.    
    
35. End Sub

複製代碼

但我這邊有三個問題

1.為什麼只要我執行VBA 會產生這個 #N/A 雖然點進去兩下就會正常
擔心是不是哪個程式碼寫錯?

下載 (22.22 KB)

2020-6-24 10:08

2.我應用相同的方式 把它寫在批量上面，但...就卡住了 批量複製是：Sub Create1() '批量複製'
會死當 哈哈

3.請問我另存的檔案名稱，可不可以根據他的日期 目前的週數 和日期命名呢?
例如，第三週  ，日期是 ：自民國 109 年 3 月 5 日 至民國 109 年 3 月 11 日 (以週計)
檔案名就會顯示：1090305~1090311(第三週).xlsx  
備註，那個109年03月05日是在F1  ， 109年03月11日 是在H1

下載 (27.79 KB)

2020-6-24 10:16

TEST02.zip (326.4 KB)

下載次數: 4

2020-6-24 10:17

edmondsforum

回復 7# edmondsforum

對不起，能麻煩幫我寫兩個針對批量複製的嗎?
可以分別寫兩個不同狀況，另存的程式碼嗎

假設我輸入5
1.    第1週.XLSX 第2週.XLSX  第3週.XLSX  第4週.XLSX  第5週.XLSX  5個檔案
2     第1~5週.XLSX (裡面有5個工作表哦)
再拜託各位亣大了:$

n7822123

回復 5# edmondsforum


xName 是從週報表複製出來的工作表 (Ex:第三週)

先把xName 去公式 再複製出活頁簿，就不會有公式

最後再把xName刪掉，就是我3樓與4樓 跟你講的寫法

感覺你5樓與7樓的回答，連試我的程式都沒有嚐試過

那我還有必要再回答下去嗎?

edmondsforum

回復 9# n7822123
對不起龍哥，請原諒我的疏忽
是我放錯位置...導致還是跑出公式，但確實你的方式是成功的

1. Sub Create3() '獨立複製'
   
2.     Dim I As Long
   
3.     Dim xWeek As Integer
   
4.     Dim xS As Worksheet
   
5.     Dim xPH$
   
6.     xPH = ThisWorkbook.Path & "\"
   
7.    
   
8.     On Error Resume Next
   
9.    
   
10.     Application.ScreenUpdating = False
    
11.     Application.DisplayAlerts = False
    
12.    
    
13.     Set xS = Sheets("週報表")
    
14.         xWeek = InputBox("請輸入第""?""週")
    
15.             xS.Copy After:=Sheets(Sheets.Count)
    
16.             ActiveSheet.Name = "第" & xWeek & "週"
    
17.                
    
18.                 Set xName = ActiveSheet
    
19.                     With ActiveSheet.UsedRange
    
20.                         .Value = .Value
    
21.                     End With
    
22.                     
    
23.                     xName.Copy
    
24.          
    
25.                         With ActiveWorkbook
    
26.                         ActiveSheet.Name = "第" & xWeek & "週"
    
27.                         .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
    
28.                         .Close
    
29.                         End With
    
30.                
    
31.                     xName.Delete
    
32.                     
    
33.     Application.ScreenUpdating = True
    
34.    
    
35. End Sub

複製代碼

能拜託大大幫我檢核 批量的嗎 拜託拜託

1. Sub Create1() '批量複製'
   
2.     Dim I As Long
   
3.     Dim xWeek As Integer
   
4.     Dim xS As Worksheet
   
5.     Dim xPH$
   
6.     xPH = ThisWorkbook.Path & "\"
   
7.    
   
8.     On Error Resume Next
   
9.    
   
10.     Application.ScreenUpdating = False
    
11.     Application.DisplayAlerts = False
    
12.    
    
13.     Set xS = Sheets("週報表")
    
14.         xWeek = InputBox("請輸入第1週～第""?""週")
    
15.         For I = 1 To xWeek
    
16.             xSt.Copy After:=Sheets(Sheets.Count)
    
17.             ActiveSheet.Name = "第" & I & "週"
    
18.             
    
19.                 Set xName = ActiveSheet
    
20.                     With ActiveSheet.UsedRange
    
21.                         .Value = .Value
    
22.                     End With
    
23.                     
    
24.                     xName.Copy
    
25.                                  
    
26.                         With ActiveWorkbook
    
27.                             ActiveSheet.Name = "第" & xWeek & "週"
    
28.                             .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
    
29.                             .Close
    
30.                         End With
    
31.         Next
    
32.         
    
33.         xName.Delete
    
34.         
    
35.     Application.ScreenUpdating = True
    
36.    
    
37. End Sub

複製代碼

另外請教，

1.是不是得新增某個程式碼，才能讓原本的"週報表"不會產生 #N/A 呢

2.另存的檔案名稱，可不可以根據他的日期 目前的週數 和日期命名呢?
   例如，第三週  ，日期是 ：自民國 109 年 3 月 5 日 至民國 109 年 3 月 11 日 (以週計)
   檔案名就會顯示：1090305~1090311(第三週).xlsx  
   備註，那個109年03月05日是在F1  ， 109年03月11日 是在H1


3.假如龍大成功寫出，批量的，能幫我分別寫出另存的時候 兩種結果嗎?
   假設輸入5
   A結果：分別產生5個檔案。( 第1週.XLSX 第2週.XLSX  第3週.XLSX  第4週.XLSX  第5週.XLSX)
   B結果：一個檔案。(第1~5週.XLSX) 裡頭有5個工作表

再拜託龍大了，我下次絕對不會目小了，對不起:Q

TEST03.zip (327.32 KB)

下載次數: 5

2020-6-24 12:42