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

Question

This seems to be a simple question so I am sorry if I should have been able to find it in the search but none of the answers have been able to help me. I am looking for a way to copy range A1:D14 and save it in a new workbook where only the format and values get saved to the new workbook.

So basiaclly I have a range of data that has a lot of formulas and values that come from other sheets, but when my current code saves it, it has to do some weird delete method and it currently saves all of the data which means the values show up, but when I click on them it is the formula inside not the actual data.

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

End Sub

I have tried adding lines where I copy the sheet and PasteSpecial XlValues but that seems to overwrite my original workbook, and I just want the values and format in a plain xlsx file. And I also feel like my code is clunky and convoluted and that there is a much easier way to go about this that looks totally different from my method.

Answer 1

Try this code, read the comments inside and look for the <<<< Customize this >>> lines:

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