Board logo

標題: 另存新檔後清除公式&巨集 [打印本頁]
作者: yc1031    時間: 2016-5-5 09:48     標題: 另存新檔後清除公式&巨集

大家好,


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

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

先感謝各位了

[attach]24164[/attach]
作者: stillfish00    時間: 2016-5-5 13:56

回復 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    時間: 2016-5-5 17:13

回復 2# stillfish00


   
十分感謝您的回覆!

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

回復 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    時間: 2016-5-10 08:32

回復 4# stillfish00


  
真的很謝謝您!

這個巨集太好用了~ 可以應用在很多地方, 再次謝謝~
作者: yc1031    時間: 2016-5-10 15:01

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




[attach]24226[/attach]
作者: stillfish00    時間: 2016-5-10 17:12

回復 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  '資料夾不存在則建立

  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
複製代碼




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