☰

Excel VBA - 将工作表保存到没有公式的新文件

tag-icon • tag-icon microsoft-excel vba
Excel VBA - 将工作表保存到没有公式的新文件

需要一些帮助来完成这个 VBA 代码，我已经尽我有限的知识所能了。

场景：我有一个主工作簿，它从程序导出的另外两个电子表格中提取数据（以保存复制/粘贴），然后我只需要导出 1 张表并保存为新文件，下面的 VBA 代码可以完美地完成这项工作。

Sub savesheet2()

Application.ScreenUpdating = False
ActiveSheet.Select
ActiveSheet.Copy
ThisFile = Range("A2").Text
Dim fileName As String
fileName = "C:\INTERNAL\ACCOUNTS\" & ThisFile
ActiveSheet.SaveAs fileName:=fileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.ScreenUpdating = True

End Sub

我需要包含的代码用于删除公式（仅导出值）并保留主书中的条件格式。

任何帮助都将不胜感激。

答案1

首先想到的是用每个单元格的值替换它。

For Each c In Cells
    c = c.Value
Next c

如果您有大量细胞，这可能需要一些时间。

或者，您可以选择整个工作表并选择性粘贴值：

Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues

这些都不应改变任何条件格式。

答案2

  Public Sub convertir_fichero(fichero_origen As String)

 Dim nuevo_libro As Workbook
 Dim indice As Integer
 Dim Ruta_Salida As String

 Set nuevo_libro = Workbooks.Add(xlWBATWorksheet)


 Application.CalculateBeforeSave = False
 Application.DisplayAlerts = False

 Workbooks(fichero_origen).Activate
 Ruta_Salida = Application.ActiveWorkbook.Path & "\Salida_aux.xlsx"

 nuevo_libro.SaveAs Ruta_Salida, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges

 For indice = 1 To Workbooks(fichero_origen).Worksheets.Count
    Dim nombre_hoja As String

    nombre_hoja = Workbooks(fichero_origen).Worksheets(indice).Name

    nuevo_libro.ActiveSheet.Name = nombre_hoja

    Workbooks(fichero_origen).Worksheets(nombre_hoja).Activate

    If Workbooks(fichero_origen).Worksheets(nombre_hoja).FilterMode = True Then
       Workbooks(fichero_origen).Worksheets(nombre_hoja).AutoFilter.ShowAllData
    End If
    Cells.Select
    Selection.Copy
    'After:=ActiveSheet
    nuevo_libro.Sheets(nombre_hoja).Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'formato
    Workbooks(fichero_origen).Worksheets(nombre_hoja).Activate
    Cells.Select
    Selection.Copy
    nuevo_libro.Sheets(nombre_hoja).Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    If ((indice Mod 5) = 0) Then
      nuevo_libro.SaveAs Ruta_Salida, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
    End If
    If (indice < Workbooks(fichero_origen).Worksheets.Count) Then
      nuevo_libro.Sheets.Add After:=ActiveSheet
    End If
 Next indice

  nuevo_libro.SaveAs Ruta_Salida, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
End Sub

相关内容