返回列表 上一主題 發帖

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

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

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

  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.    
  12.     Set xS = Sheets("週報表")
  13.         xWeek = InputBox("請輸入第""?""週")
  14.             xS.Copy After:=Sheets(Sheets.Count)            
  15.             ActiveSheet.Name = "第" & xWeek & "週"
  16.                 Set xName = ActiveSheet
  17.                     xName.Copy
  18.                     
  19.             Application.DisplayAlerts = False
  20.             
  21.                 With xName.UsedRange
  22.                     .Value = .Value
  23.                 End With                                                         

  24.                 With ActiveWorkbook
  25.                     ActiveSheet.Name = "第" & xWeek & "週"
  26.                     .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
  27.                     .Close
  28.                 End With
  29.                
  30.     Application.ScreenUpdating = True
  31.    
  32. 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
複製代碼
但另存的檔案內容還是參照到"週報表"函數......甚至條件不足造成亂碼,
不知道怎麼把它寫成,另存之後也是以純貼上值的方式........
再請求各位大神指點迷津.....拜託了

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

TOP

本帖最後由 n7822123 於 2020-6-24 00:50 編輯

回復 1# edmondsforum

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

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

所以要調換順序,先寫


With xName.UsedRange
     .Value = .Value
End With


再寫

xName.Copy

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


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

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

xName.delete

如果執行有錯的話,請附上檔案來看看吧,我幾乎是盲寫
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2020-6-24 01:13 編輯

回復 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
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 4# n7822123
抱歉果然真的沒檔案會讓人很難理解@@
請諒解,我再度述說一次
1.假設我執行VBA了,輸入週數了
01.png
2020-6-24 08:25


2.輸入3之後,會產生"第3周",此時地這個檔案的第3週
事先根據第3週去跑VLOOKUP後,以純值貼上。
02.png
2020-6-24 08:25


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

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


5.然後我點開產生另一個檔案的"第三週" 仍然還是有公式存在
05.png
2020-6-24 08:26


6.以上就是我的問題,目前檔案裡面有三個程式碼
06.png
2020-6-24 08:26

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

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

TOP

回復 5# edmondsforum

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

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

TOP

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

  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.    
  12.     Set xS = Sheets("週報表")
  13.         xWeek = InputBox("請輸入第""?""週")
  14.             xS.Copy After:=Sheets(Sheets.Count)
  15.             ActiveSheet.Name = "第" & xWeek & "週"
  16.                 Set xName = ActiveSheet
  17.                     xName.Copy
  18.                     
  19.             Application.DisplayAlerts = False
  20.             
  21.                 With ActiveSheet.UsedRange
  22.                     .Value = .Value
  23.                 End With

  24.                 With ActiveWorkbook
  25.                     ActiveSheet.Name = "第" & xWeek & "週"
  26.                     .SaveAs xPH & "第" & xWeek & "週.xlsx", CreateBackup:=False
  27.                     .Close
  28.                 End With
  29.                
  30.     xName.Delete
  31.     Application.ScreenUpdating = True
  32.    
  33. End Sub
複製代碼
但我這邊有三個問題

1.為什麼只要我執行VBA 會產生這個 #N/A 雖然點進去兩下就會正常
擔心是不是哪個程式碼寫錯?
01.png
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
02.png
2020-6-24 10:16


TEST02.zip (326.4 KB)

TOP

回復 7# edmondsforum

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

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

TOP

本帖最後由 n7822123 於 2020-6-24 12:04 編輯

回復 5# edmondsforum


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

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

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

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

那我還有必要再回答下去嗎?
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 edmondsforum 於 2020-6-24 12:43 編輯

回復 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)

TOP

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題