另存新檔後清除公式&巨集

yc1031

大家好,


想請教一下,  我文件另存新檔後, 有幾個動作想做, 但不知道要怎麼在新的EXCEL表中設

1.  刪除所有公式&巨集
2.  刪除欄位 Y20~AA20

先感謝各位了

TEST1.rar (26.33 KB)

下載次數: 6

2016-5-5 09:48

stillfish00

回復 1# yc1031
另存 "Report" 工作表

1. Sub Test()
   
2.   Dim wbNew As Workbook
   
3.   Set wbNew = Workbooks.Add
   
4.   
   
5.   ThisWorkbook.Sheets("Report").Copy Before:=wbNew.Sheets(1)
   
6.   With wbNew.Sheets(1)
   
7.     .UsedRange.Value = .UsedRange.Value
   
8.     .[Y20:AA20].Delete Shift:=xlShiftToLeft
   
9.   End With
   
10. End Sub

複製代碼

yc1031

回復 2# stillfish00


   
十分感謝您的回覆!

我剛有測試成功了
想再請問一下  ThisWorkbook.Sheets("Report").Copy Before:=wbNew.Sheets(1)
這個wbNew.Shhets  copy出來以後,這個新的檔名若是要以 z20 欄位的資料為檔名的話, 讓怎麼設呢?

stillfish00

回復 3# yc1031

1. Sub Test()
   
2.   Dim wbNew As Workbook, name As String
   
3.   Set wbNew = Workbooks.Add
   
4.   
   
5.   ThisWorkbook.Sheets("Report").Copy Before:=wbNew.Sheets(1)
   
6.   With wbNew.Sheets(1)
   
7.     .UsedRange.Value = .UsedRange.Value
   
8.     name = .[Z20]
   
9.     .[Y20:AA20].Delete Shift:=xlShiftToLeft
   
10.     .SaveAs ThisWorkbook.Path & Application.PathSeparator & name
    
11.   End With
    
12. End Sub

複製代碼

yc1031

回復 4# stillfish00


  
真的很謝謝您!

這個巨集太好用了~ 可以應用在很多地方, 再次謝謝~

yc1031

回復 4# stillfish00


您好,  我有二個步驟, 但不知道怎麼合併,  能請問該怎麼改嗎?  感謝!

1. 我在桌面建立有指定名稱的空資料夾,  OK
2. 建立文字檔後, 另存新檔且指定名稱的EXCEL檔,   OK
3. 這個EXCEL 檔, 我想放進這個空資料夾(或其它指定的資料夾) ,  這裡不知道怎麼改........  



Sub AddFolder()

On Error Resume Next
MkDir (ThisWorkbook.Path & "/" & Range("I3"))
On Error GoTo 0
Dim wbNew As Workbook, name As String
Set wbNew = Workbooks.Add
ThisWorkbook.Sheets("SI").Copy Before:=wbNew.Sheets(1)
With wbNew.Sheets(1)
.UsedRange.Value = .UsedRange.Value
name = "SI -" & .[L12]
.[P1:Q100].Delete Shift:=xlShiftToLeft
.SaveAs ThisWorkbook.Path & Application.PathSeparator & name

End With
End Sub




test.rar (163.8 KB)

下載次數: 6

2016-5-10 14:53

stillfish00

回復 6# yc1031

1. Sub AddFolder()
   
2.   Dim folder As String
   
3.   Dim wbNew As Workbook, name As String
   
4.   
   
5.   With ActiveSheet  '當前工作表
   
6.     folder = ThisWorkbook.path & Application.PathSeparator & .Range("k12")  '存檔資料夾路徑
   
7.     If Dir(folder, vbDirectory) = "" Then MkDir folder  '資料夾不存在則建立
   
8. 
   
9.     Set wbNew = Workbooks.Add   '新增工作簿
   
10.     .Copy Before:=wbNew.Sheets(1) '複製到新工作簿的最前面
    
11.   End With
    
12.   
    
13.   With wbNew.Sheets(1)  '新工作簿第一個工作表
    
14.     .UsedRange.Value = .UsedRange.Value   '使用到的範圍重新賦值(為了清除公式)，或是 複製>貼上值
    
15.     name = "SI -" & .[k12]  '檔案命名
    
16.     .[P1:Q100].Delete Shift:=xlShiftToLeft  '刪除不必要欄位
    
17.     .Shapes("Oval 35").Delete    '新的檔案移除這個呼叫巨集的圖案
    
18.     .SaveAs folder & Application.PathSeparator & name  '另存新檔
    
19.     .Parent.Close '新工作簿關閉
    
20.   End With
    
21.   MsgBox "已匯出!"
    
22. End Sub

複製代碼