时间戳

首页 > 解决方案 > 导出 Activesheet - 仅值

excel - 导出 Activesheet - 仅值

问题描述

我正在使用此代码，它工作正常，但它也复制：

我正在寻找一种方法来仅复制工作表的值，同时保留其原始格式，然后像我的宏一样关闭新创建的工作簿。

Sub export_sheet()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim strSourceSheet As Worksheet
Dim strname As String
Dim path As String

Application.DisplayAlerts = False

path = ThisWorkbook.path & "\"
strname = "test_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsx"

Set strSourceSheet = ActiveSheet

ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=path & strname, FileFormat:=51, CreateBackup:=True
ActiveWorkbook.Close

Application.DisplayAlerts = True
End Sub

标签： excelvba

解决方案

像这样的东西应该适合你：

Sub tgr()

    Dim wb As Workbook
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim rFirst As Range
    Dim rLast As Range
    Dim rDest As Range
    Dim sFolderPath As String
    Dim sFileName As String

    Set wb = ThisWorkbook
    Set wsCopy = wb.ActiveSheet
    Set rFirst = wsCopy.Cells.Find("*", wsCopy.Cells(wsCopy.Rows.Count, wsCopy.Columns.Count), xlValues, xlPart, , xlNext)
    Set rLast = wsCopy.Cells.Find("*", wsCopy.Range("A1"), xlValues, xlPart, , xlPrevious)
    sFolderPath = ThisWorkbook.Path & Application.PathSeparator
    sFileName = "test_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsx"

    wb.Worksheets.Add.Move  'create new workbook with a blank worksheet
    Set wsDest = ActiveWorkbook.ActiveSheet 'the newly created workbook and sheet will be active because they were just created
    With wsDest
        Set rDest = .Cells(rFirst.Row, rFirst.Column)
        wsCopy.Range(rFirst, rLast).Copy
        rDest.PasteSpecial xlPasteValues
        rDest.PasteSpecial xlPasteFormats
        rDest.PasteSpecial xlPasteColumnWidths
        .Parent.SaveAs sFolderPath & sFileName, xlOpenXMLWorkbook
        .Parent.Close True
    End With

End Sub

推荐阅读