PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-5-19 00:17 | 只看該作者

[發問] 快速copy並值化

請問以下的程式
它可以快速copy每個工作表
但copy後我要它也同時做數值化的動作，但它只會值化第一個工作表
請問要如何讓它值化每一個工作表？

Sub Qcopy()
Set Wb = Workbooks("進出口請款.2017.xlsx")
Wb.Sheets.Copy
For Each Sh In Wb.Sheets
Sh.Visible = True
Next
For Each Sh In Wb.Sheets
Cells.Select
Selection.Copy
Selection.PasteSpecial xlPasteValues '值化
Next
End Sub

複製代碼

樓主熱帖

naruto018

中學生 Rank: 2

帖子: 91
主題: 5
精華: 0
積分: 130
點名: 0
作業系統: Win10
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2016-5-14
最後登錄: 2020-5-17

2^#

發表於 2018-5-19 08:08 | 只看該作者

回復 1# PJChen

只在第一個工作表貼上值，是因為沒有指定工作表，所以只對當前的工作表作用
要改成下面這樣

For Each Sh In Wb.Sheets
Sh.Cells.Copy
Sh.Cells.PasteSpecial xlPasteValues '值化
Next

複製代碼

TOP

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

3^#

發表於 2018-5-19 11:06 | 只看該作者

Sub zz()
For Each s In Sheets
With s
.UsedRange = .UsedRange.Value
End With
Next
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2018-5-19 14:28 | 只看該作者

回復 2# naruto018

您好,

但我原先的程式功能是可以將原檔快速的完全複製，
程式作修改後,確實能夠將每個工作表都值化，但是它是將原檔值化，而沒有另外copy成新檔.

請問可以如何修改成我要的功能？

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

5^#

發表於 2018-5-19 14:35 | 只看該作者

回復 3# ikboy

您好,

原先的程式功能是可以將原檔快速的完全複製，
測試過您修改的程式後,它完全沒有任何改變，我想是因為我原先的程式中有Dim的宣告,稍作修改為以下後,
確實能夠很快速的將每個工作表都值化，但與2樓的程式相同，它只是將原檔值化，而沒有另外copy成新檔.

請問可以如何修改成我要的功能？

Sub Qcopy()
Option Explicit
Dim Wb As Workbook, Sh As Worksheet, Rng As Range
Set Wb = Workbooks("進出口請款.2017.xlsx")
For Each Sh In Wb.Sheets
With Sh
.UsedRange = .UsedRange.Value
End With
Next
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

6^#

發表於 2018-5-19 18:25 | 只看該作者

本帖最後由 PJChen 於 2018-5-19 18:27 編輯

回復 2# naruto018

大大好,
改成以下就達成我要的功能了,謝謝！

Sub Qcopy()
Set Wb = Workbooks("進出口請款.2017.xlsx")
Wb.Sheets.Copy
For Each Sh In Sheets
Sh.Cells.Copy
Sh.Cells.PasteSpecial xlPasteValues '值化
Next
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

7^#

發表於 2018-5-19 18:35 | 只看該作者

本帖最後由 PJChen 於 2018-5-19 18:38 編輯

回復 3# ikboy
您好,
您的程式可以執行得更快速，我將程式改為以下，利用O1儲存格去指定檔名,但sheet也想用指定的方式寫在Q2，
例如：我想讓所有檔名包含"338"的工作表(也就是Q2=338)全部都值化，請問該如何寫這一段程式？

Option Explicit
Dim Wb As Workbook, Sh As Worksheet
Sub Qcopy()
Set Wb = Workbooks(Workbooks("VBA報表指令.xlsm").Worksheets("動作").Range("O1").Value) '儲存格的值為檔案名稱
Wb.Sheets.Copy
For Each Sh In Sheets
With Sh
.UsedRange = .UsedRange.Value
End With
Next
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

8^#

發表於 2018-5-20 20:12 | 只看該作者

回復 7# PJChen

請問:
以下程式，檔名指定在O1，O1檔案全部copy後值化。
我想做另一種方式，除了O1指定檔名外，將sheet的名稱指定在Q2，讓sheet名稱可以自由變動，也就是只要sheet名稱含蓋在Q2的名稱內，都可以自動完全複製到新檔案中並值化，請問該如何修改以下程式？

Sub Qcopy()
Set Wb = Workbooks(Workbooks("VBA報表指令.xlsm").Worksheets("動作").Range("O1").Value) '儲存格的值為檔案名稱
Wb.Sheets.Copy
For Each Sh In Sheets
With Sh
.UsedRange = .UsedRange.Value '值化
Application.DisplayAlerts = False '在程序執行過程中使出現的警告框不顯示
End With
Next
End Sub

複製代碼

TOP