VBA：仅复制和粘贴特定范围的值并保存在新工作簿中

Question

这似乎是一个简单的问题，所以如果我应该能够在搜索中找到它，但没有一个答案能够帮助我，我很抱歉。我正在寻找一种复制范围 A1:D14 并将其保存在新工作簿中的方法，其中仅将格式和值保存到新工作簿中。

所以基本上我有一个数据范围，其中有很多来自其他工作表的公式和值，但是当我当前的代码保存它时，它必须执行一些奇怪的删除方法，它当前保存了所有数据表示值显示，但当我点击它们时，它是里面的公式而不是实际数据。

Sub SaveData()


Dim SaveFile As String

Dim Title As String


Title = "DigitalStorage"



SaveFile = Application.GetSaveAsFilename(InitialFileName:=Title & "_" & Format(Now, "yyyy-MM-dd hh-mm-ss"), _
                                         fileFilter:="Excel Workbooks (*.xlsx),*.xlsx")


ThisWorkbook.Worksheets("SaveSheet").Copy



With ActiveWorkbook

    With .Worksheets("SaveSheet")

        ThisWorkbook.Sheets(1).Range("A1:D14").Copy

        .Columns("E:ABC").EntireColumn.Delete

        .Rows("14:100").EntireRow.Delete

    End With

    .SaveAs Filename:=SaveFile, FileFormat:=xlOpenXMLWorkbook

    .Close savechanges:=False

End With

结束子

我尝试在复制工作表和 PasteSpecial XlValues 的位置添加行，但这似乎覆盖了我原来的工作簿，我只想要一个普通 xlsx 文件中的值和格式。而且我还觉得我的代码笨重且令人费解，而且有一种更简单的方法可以解决这个问题，看起来与我的方法完全不同。

Answer 1

试试这个代码，阅读里面的 cmets 并寻找 >> 行：

Sub SaveData()

    ' Declare objects
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim cellRange As Range

    ' Declare other variables
    Dim targetWorkbookName As String
    Dim targetWorkbookTitle As String

    Dim sourceSheetName As String
    Dim sourceRangeAddress As String
    Dim targetRangeAddress As String

    Dim rowCounter As Long


    ' <<< Customize this >>>
    sourceSheetName = "SaveSheet" ' Name of the source sheet
    sourceRangeAddress = "A1:D14" ' Address of the range you want to copy in the source workbook
    targetRangeAddress = "A2" ' Cell address where you want to paste the copied range
    targetWorkbookTitle = "DigitalStorage" ' Base file name

    ' Reference source workbook
    Set sourceWorkbook = ThisWorkbook

    ' Create a new workbook
    Set targetWorkbook = Application.Workbooks.Add

    ' Set reference to source range
    Set sourceRange = sourceWorkbook.Sheets(sourceSheetName).Range(sourceRangeAddress)

    ' Copy the range to clipboard
    sourceRange.Copy

    ' This copies the range in the first available worksheet begining in the cell address specified
    targetWorkbook.Sheets(1).Range(targetRangeAddress).PasteSpecial Paste:=xlPasteValues
    targetWorkbook.Sheets(1).Range(targetRangeAddress).PasteSpecial Paste:=xlPasteFormats
    targetWorkbook.Sheets(1).Range(targetRangeAddress).PasteSpecial Paste:=xlPasteColumnWidths

    Set targetRange = targetWorkbook.Sheets(1).Range(targetRangeAddress).Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)

    ' Adjust row heights
    For Each cellRange In sourceRange.Columns(1).Cells

        rowCounter = rowCounter + 1

        targetRange.Rows(rowCounter).RowHeight = cellRange.RowHeight

    Next cellRange

    ' Set the name of the new workbook
    targetWorkbookName = Application.GetSaveAsFilename(InitialFileName:=targetWorkbookTitle & "_" & Format(Now, "yyyy-MM-dd hh-mm-ss"), _
                                         fileFilter:="Excel Workbooks (*.xlsx),*.xlsx")

    If targetWorkbookName = vbNullString Then
        MsgBox "Saving operation canceled"
        Exit Sub
    End If

    ' Save the new workbook
    targetWorkbook.SaveAs Filename:=targetWorkbookName ' Un comment this if you want it in OpenXML format: , FileFormat:=xlOpenXMLWorkbook

    ' Close the new saved workbook (in this line couldn't figure out if you wanted to close the new or the old workbook
    targetWorkbook.Close  ' savechanges:=False


End Sub