Question

我使用的代码可以正常工作，但它也可以复制：

公式
形状
工作表中嵌入的宏

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

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

Answer 1

类似的事情应该对您有用：

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

Answer 2

尝试一下：

Sub export_sheet()
    Dim sourceWB As String
    Dim destWB As String
    Dim strSourceSheet As String
    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"

    strSourceSheet = ActiveSheet.Name
    sourceWB = Activeworkbook.Name

    Sheets(strSourceSheet).Copy
     ‘If want to copy yo new wb
    Workbooks.Add
    DestWB = Activeworkbook.Name
     ‘Or if DestWb already exists then 
     ‘DestWB = yourdestinationwb.xlsx
     ‘Windows(DestWB).Activate
     ‘Sheets(1).Select
    Activesheet.Range(“A1”).SeLect
    Selection.PasteSpecial Paste:=XlPasteValues
    Selection.PasteSpecial Paste:=XlPasteFormats
    ActiveWorkbook.SaveAs Filename:=path & strname, FileFormat:=51, CreateBackup:=True
    ActiveWorkbook.Close

    Application.DisplayAlerts = True
    End Sub

Excel VBA-导出Activesheet-仅值

2 个答案: