Question

ACTUAL代码将数据复制并粘贴到单独的工作簿中。我需要将数据复制并粘贴为值，同时将所有格式和边框线等保存到单独的工作簿中。如果有人可以使用我当前的代码工作方式来调整我的代码以将其粘贴为具有格式的值，那么这将是非常有用的。唯一的问题是公式附带粘贴部分。

我试图用我当前的代码运行一周的事情是添加这部分，但仍然无法按预期工作。预先非常感谢

  **For Each xWs In xWb.Worksheets
     xWs.Copy
       With xWs.UsedRange
        .Value = .Value
      End With

      If Val(Application.Version) < 12 Then
           FileExtStr = ".xls": FileFormatNum = -4143
       Else**

下面的实际代码

  Sub SplitWorkbook()

   Dim FileExtStr As String 
   Dim FileFormatNum As Long 
   Dim xWs As Worksheet 
   Dim xWb As Workbook 
   Dim FolderName As String

   Application.ScreenUpdating = False
   Set xWb = Application.ThisWorkbook
   DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
   FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
   MkDir FolderName

       For Each xWs In xWb.Worksheets
       xWs.Copy
         If Val(Application.Version) < 12 Then
          FileExtStr = ".xls": FileFormatNum = -4143
            Else
           Select Case xWb.FileFormat
        Case 51:
          FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
          If Application.ActiveWorkbook.HasVBProject Then
          FileExtStr = ".xlsm": FileFormatNum = 52
        Else
          FileExtStr = ".xlsx": FileFormatNum = 51
        End If
        Case 56:
          FileExtStr = ".xls": FileFormatNum = 56
        Case Else:
          FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
        End If

        xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
         Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
         Application.ActiveWorkbook.Close False
        Next
        MsgBox "You can find the files in " & FolderName
        Application.ScreenUpdating = True

  End Sub

复制为带格式的值，而不是使用公式粘贴值

下面的实际代码

0 个答案: