Excel VBA - Экспорт ActiveSheet - только значения - PullRequest
Новая
       30

Excel VBA - Экспорт ActiveSheet - только значения

0 голосов
/ 30 мая 2019

Я использую этот код, который отлично работает, но также копирует:

  • Формулы
  • Форма
  • Макросы, встроенные в лист

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

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

Ответы [ 2 ]

1 голос
/ 31 мая 2019

Как-то так должно работать у вас: 

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
0 голосов
/ 31 мая 2019

Попробуйте это: 

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
...