VBA называет новую книгу, используя фразу, ссылку на ячейку и дату из ячейки

Question

У меня есть следующий код, который создает новый лист. Я пытаюсь назвать новый лист с помощью фразы, содержимого ячейки 1 и даты в ячейке 2. Ячейка 1 будет содержать некоторые данные, которые вставляются с помощью проверки данных (всего 4 варианта), а ячейка 2 будет иметь дата.

ПРИМЕР: ВХОДНЫЕ ДАННЫЕ РАБОТЫ Диапазон C3. Значение ячейки 1 = Торговая деятельность, покупки, продажи ... и т. Д. c

Рабочий лист ВХОДЫ Диапазон C2. Значение ячейки 2 = 2.11.2020

Имя новой рабочей книги будет "Имя клиента Торговые операции - 2.11.2020"

И ячейка 1, и ячейка 2 будут находиться в рабочей таблице INPUTS

Private Sub CommandButton1_Click()
Dim targetWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim formatDate As String
Dim fileName As String

Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False
If ThisWorkbook.Worksheets("INPUTS").Range("C3").Value <> vbNullString Then
    formatDate = Format(Sheets("INPUTS").Range("C3"), "YYYY.MM.DD")
End If
fileName = "Name - " & ActivityName & formatDate
sourceSheet.Outline.ShowLevels ColumnLevels:=1 
sourceSheet.Range("A:M").AutoFilter Field:=12, Criteria1:="<>0"
Set targetWorkbook = Workbooks.Add
sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1")
targetWorkbook.Sheets("sheet1").Columns("A:AC").EntireColumn.AutoFit
targetWorkbook.SaveAs ThisWorkbook.Path & "\" & fileName & ".xlsx", FileFormat:=51
End Sub

Answer 1

Некоторые вещи, которые нужно помнить:

1. Определите и используйте переменные всякий раз, когда сможете
2. Попробуйте добавлять комментарии к своему коду, объясняя цель того, что вы делаете (ваш Я или кто-то, кто когда-либо будет работать с вашими файлами, поблагодарит вас)
3. Оставьте пробелы между основными частями вашего кода, чтобы сделать его более читабельным

РЕДАКТИРОВАТЬ : Добавлен обработчик ошибок, когда пользователь нажимает «Нет» при запросе перезаписать существующий файл

Код:

Private Sub CommandButton1_Click()

    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet

    Dim formatDate As String
    Dim fileName As String

    On Error GoTo CleanFail

    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")

    ' Remove filter
    If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False

    If sourceSheet.Range("F1").Value <> vbNullString Then
        formatDate = Format(sourceSheet.Range("F1").Value, "YYYY.MM.DD")
    End If

    ' Set the new workbook file name
    fileName = "NAME - " & formatDate

    ' Filter the fileNames
    sourceSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="<>"

    ' Add new workbook and set reference
    Set targetWorkbook = Workbooks.Add

    ' Copy the visible fileNames in a new workbook
    sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1")

    ' Save the new workbook
    targetWorkbook.SaveAs ThisWorkbook.Path & "\" & fileName & ".csv", FileFormat:=xlCSV

CleanExit:
    Exit Sub

CleanFail:
    Select Case Err.Number

    Case 1004
        MsgBox "You cancel the process"
        Resume Next
    Case Else
        ' Do something else? handle it properly...
        MsgBox "Something went wrong..."
        Resume CleanExit
    End Select

End Sub

Дайте мне знать, если он работает