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

End Sub

Я попытался добавить строки, где я копирую лист и PasteSpecial XlValues, но это, кажется, перезаписывает мою оригинальную книгу, и я просто хочузначения и формат в простом файле xlsx.И я также чувствую, что мой код неуклюж и запутан, и есть гораздо более простой способ, который выглядит совершенно иначе, чем мой метод.

Answer 1

Попробуйте этот код, прочитайте комментарии внутри и найдите <<<< Настройте эту строку >>>:

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