我想创建一个VBA代码,将工作簿复制到一个单独的工作簿(workbook2)中,然后在第二个工作簿中将所有公式转换为值,因此不应在工作簿1(活动的工作簿)中进行转换。我找到了执行转换的代码,但是我不知道如何在工作簿2中执行它。然后,我应该保存该工作簿2。有什么想法吗?代码下方
Sub ConvertFormulasToValuesAllWorksheets()
On Error Resume Next
Dim ws As Worksheet, rng As Range
For Each ws In ActiveWorkbook.Worksheets
For Each rng In ws.UsedRange
If rng.HasFormula Then
rng.Formula = rng.Value
End If
Next rng
Next ws
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\myusid\Desktop\myfolder\workbook2.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' need to
change the name of the folder
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
谢谢。
答案 0 :(得分:1)
这是另一种方法,可让您灵活地设置变量中的文件名和路径。
还有一些好的做法:
Option Explicit
,因此需要变量声明编辑:添加了与原始资料相同的工作表顺序,并删除了多余的工作表
代码:
Option Explicit
Public Sub ConvertFormulasToValuesAllWorksheets()
Dim newBook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim filePath As String
Dim fileName As String
Dim fileFullPath As String
On Error GoTo CleanFail
Application.DisplayAlerts = False
' Build the path
filePath = "C:\Temp\" ' "C:\Users\myusid\Desktop\myfolder\"
fileName = "workbook2.xlsx"
fileFullPath = filePath & fileName
' Add a new workbook
Set newBook = Workbooks.Add
' Save it with the path built
newBook.SaveAs fileName:=fileFullPath ', FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
For Each sourceSheet In ThisWorkbook.Sheets
' Copy the sheet
sourceSheet.Copy After:=Workbooks(fileName).Sheets(sourceSheet.Index)
Set targetSheet = newBook.Worksheets(sourceSheet.Name)
' Copy/paste values
targetSheet.UsedRange.Value = sourceSheet.UsedRange.Value
Next sourceSheet
' Delete other sheets
For Each targetSheet In newBook.Worksheets
If Not WorksheetExists(targetSheet.Name, ThisWorkbook) Then
targetSheet.Delete
End If
Next targetSheet
CleanExit:
Application.DisplayAlerts = True
Exit Sub
CleanFail:
MsgBox Err.Description
GoTo CleanExit
End Sub
Private Function WorksheetExists(sheetName As String, targetBook As Workbook) As Boolean
Dim evalSheet As Worksheet
On Error Resume Next
Set evalSheet = targetBook.Sheets(sheetName)
On Error GoTo 0
WorksheetExists = Not (evalSheet Is Nothing)
End Function
让我知道它是否有效。
答案 1 :(得分:0)
尝试
Sub ConvertFormulasToValuesAllWorksheets()
Dim ws As Worksheet, rng As Range
Dim wb1 As Workbook, wb2 As Workbook
' the workbook to copy
Set wb1 = ThisWorkbook
' Copy all sheets from wb1 to new workbook
wb1.Sheets.Copy
Set wb2 = ActiveWorkbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End with
For Each ws In wb2.Sheets
With ws
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Next ws
wb2.SaveAs Filename:= _
"C:\Users\myusid\Desktop\myfolder\workbook2.xlsx" _
,FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
With Application
.DisplayAlerts = True
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub