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

问题描述 投票:0回答:1

这似乎是一个简单的问题,所以我很抱歉,如果我能够在搜索中找到它,但没有一个答案能够帮助我。我正在寻找一种方法来复制范围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文件中的值和格式。而且我也觉得我的代码很笨拙和复杂,并且有一种更简单的方法可以解决这个问题,看起来与我的方法完全不同。

excel vba
1个回答
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
© www.soinside.com 2019 - 2024. All rights reserved.