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

嘗試以下代碼，閱讀其中的注釋，並查找<<<< Customize this >>>行：

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