Скопируйте лист в новую книгу и сохраните

Question

1. Копировать рабочую таблицу 1 в рабочую книгу A
2. Создать новую рабочую книгу (названную ниже)
3. Копировать рабочую таблицу 1 в новую рабочую книгу
4. Сохранить новую рабочую книгу как 'ab c (ежедневно) & Format (Date, "ddmmmyyy") & ".xlsm" - т.е. код будет сохраняться таким образом, который зависит от сегодняшней даты

Я не уверен, где я ' я ошибаюсь

'Save Worksheet1 as Workbook
Worksheets("Worksheet 1").Activate
With Worksheets("Worksheet 1")
    .copy
End With
saveLocation = "X:\abc\abc\abc (daily)" & Format(Date, "ddmmmyyy") & ".xlsm"

ActiveSheet.ExportAsFixedFormat Type:=xlTypexlsm, _
    Filename:=saveLocation

Answer 1

Экспорт рабочего листа

• Перед запуском кода настройте значения переменных NewFilePath и SourceSheet в Sub exportFirst. NewFilePath должен не оканчиваться обратным символом sh \.
• Код написан для ссылки на рабочий лист в ThisWorkbook, то есть на рабочую книгу, содержащую этот код.
• Sub exportFirst вызывает Sub exportWorksheet.
• Вы можете написать несколько подпрограмм, например, Sub exportFirst для других рабочих листов в книге.
• Я бы предпочел использовать, например, Worksheets("Sheets1") Worksheets(1).
• После того, как вы закончили тестирование кода, вам, вероятно, следует откомментировать строку .Close.

Option Explicit

Sub exportFirst()

    Const NewFilePath As String _
      = "C:\Test"

    Dim SourceSheet As Worksheet
    Set SourceSheet = ThisWorkbook.Worksheets(1)

    exportWorksheet SourceSheet, NewFilePath

End Sub

Sub exportWorksheet(SourceSheet As Worksheet, NewFilePath As String)

    Dim NewFileName As String
    Dim SaveLocation As String

    ' Either:
'    ' If you want to name the new workbook using 'SourceSheet.Name':
    NewFileName = SourceSheet.Name
'    ' Or:
'    ' If you want to name the new workbook using 'ThisWorkbook.Name':
'    NewFileName _
'      = Left$(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)

    ' I would prefer "yyyymmdd" or at least "ddmmmyyyy"
    SaveLocation = NewFilePath & "\" & NewFileName & " (daily)" _
      & Format(Date, "ddmmmyyy")

    SourceSheet.Copy

    With ActiveWorkbook

        ' Either:
        ' .xlsm
        SaveLocation = SaveLocation & ".xlsm"
        .SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
          Filename:=SaveLocation

        ' or:
        ' .xlsx
'        SaveLocation = SaveLocation & ".xlsx"
'        .SaveAs FileFormat:=xlOpenXMLWorkbook, _
'          Filename:=SaveLocation

        ' or:
        ' .csv
'        SaveLocation = SaveLocation & ".csv"
'        .SaveAs FileFormat:=xlCSVUTF8, Filename:=SaveLocation

        ' or:
        ' .pdf
'        SaveLocation = SaveLocation & ".pdf"
'        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=SaveLocation
'        .Saved = True

        '.Close ' You should use '.Close' always with '.pdf'.

    End With

End Sub

Answer 2

Sub CopySheetAsNewWorkbook()

Dim theNewWorkbook As Workbook
Dim currentWorkbook As Workbook

'currentWorkbook is the source workbook, create a new workbook referencing to it with theNewWorkbook
Set currentWorkbook = ActiveWorkbook
Set theNewWorkbook = Workbooks.Add

'do the copy (it's better to check if there is already a 'Worksheet 1' in the new workbook. It it exists delete it or rename it
currentWorkbook.Worksheets("Worksheet 1").Copy before:=theNewWorkbook.Sheets(1)

'Remove default sheets in order to have only the copied sheet inside the new workbook
Application.DisplayAlerts = False
Dim i As Integer
For i = theNewWorkbook.Sheets.Count To 2 Step -1
    theNewWorkbook.Sheets(i).Delete
Next i
Application.DisplayAlerts = True

'Save File as XLSM
saveLocation = "X:\abc\abc\abc (daily)" & Format(Date, "ddmmmyyy") & ".xlsm"
theNewWorkbook.SaveAs Filename:=saveLocation, FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled
theNewWorkbook.Close

End Sub

Answer 3

Может быть попробовать что-то вроде этого:

Sub test()
Path = "D:\"
Filename = "test "
Sheets("Worksheet 1").Copy
' for multiple sheets : Sheets(Array("TABEL", "DATA", "BACKUP")).Copy
' to save with time : ActiveWorkbook.SaveAs Filename:=Path & Filename & Format(Now(), "yymmdd hh mm ss") & ".xlsm", FileFormat:=52
ActiveWorkbook.SaveAs Filename:=Path & Filename & Format(Date, "ddmmyy") & ".xlsm", FileFormat:=52
ActiveWorkbook.Close
End Sub