yc1031

帖子: 106
主題: 35
精華: 0
積分: 146
點名: 0
作業系統: Window 7
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2011-8-30
最後登錄: 2024-3-26

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2016-5-5 09:48 | 只看該作者

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

大家好,

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

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

先感謝各位了

TEST1.rar (26.33 KB)

TEST1.rar (26.33 KB)

樓主熱帖

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

7^#

發表於 2016-5-10 17:12 | 只看該作者

回復 6# yc1031

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

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

yc1031

中學生 Rank: 2

帖子: 106
主題: 35
精華: 0
積分: 146
點名: 0
作業系統: Window 7
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2011-8-30
最後登錄: 2024-3-26

6^#

發表於 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

test.rar (163.8 KB)

TOP

yc1031

中學生 Rank: 2

帖子: 106
主題: 35
精華: 0
積分: 146
點名: 0
作業系統: Window 7
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2011-8-30
最後登錄: 2024-3-26

5^#

發表於 2016-5-10 08:32 | 只看該作者

回復 4# stillfish00

真的很謝謝您!

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

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

4^#

發表於 2016-5-6 10:55 | 只看該作者

回復 3# yc1031

Sub Test()
Dim wbNew As Workbook, name As String
Set wbNew = Workbooks.Add
ThisWorkbook.Sheets("Report").Copy Before:=wbNew.Sheets(1)
With wbNew.Sheets(1)
.UsedRange.Value = .UsedRange.Value
name = .[Z20]
.[Y20:AA20].Delete Shift:=xlShiftToLeft
.SaveAs ThisWorkbook.Path & Application.PathSeparator & name
End With
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

yc1031

中學生 Rank: 2

帖子: 106
主題: 35
精華: 0
積分: 146
點名: 0
作業系統: Window 7
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2011-8-30
最後登錄: 2024-3-26

3^#

發表於 2016-5-5 17:13 | 只看該作者

回復 2# stillfish00

十分感謝您的回覆!

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

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2016-5-5 13:56 | 只看該作者

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

Sub Test()
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
ThisWorkbook.Sheets("Report").Copy Before:=wbNew.Sheets(1)
With wbNew.Sheets(1)
.UsedRange.Value = .UsedRange.Value
.[Y20:AA20].Delete Shift:=xlShiftToLeft
End With
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP