返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 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
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 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
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 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
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。
返回列表 上一主題