VBA Сохранение только видимых данных в новый лист по тому же пути - PullRequest
0 голосов
/ 10 февраля 2020

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

Идея состоит в том, чтобы сохранить мой лист по тому же пути после фильтрации любых пустых значений. Новый файл будет иметь значения только в CSV. Опять же, все это работает, за исключением случаев, когда речь идет о фильтрации данных и сохранении файла.

Теперь я получаю

"Ошибка времени выполнения 438 Объект не поддерживает это свойство или метод "

по коду ниже

ThisWorkbook.Sheets("SHEET1").SpecialCells(xlCellTypeVisible).Copy

Полный код

Private Sub CommandButton1_Click()

If Sheets("SHEET1").AutoFilterMode Then Sheets("SHEET1").AutoFilterMode = False

sDate = Format(Sheets("SHEET2").Range("F1"), "YYYY.MM.DD")
cell = "NAME - " & sDate
ThisWorkbook.Sheets("SHEET1").Range("A:C").AutoFilter Field:=2, Criteria1:="<>"
ThisWorkbook.Sheets("SHEET1").SpecialCells(xlCellTypeVisible).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & cell & ".csv", FileFormat:=xlCSV
End Sub

1 Ответ

0 голосов
/ 10 февраля 2020

Пожалуйста, прочитайте комментарии к коду и настройте его в соответствии с вашими потребностями

РЕДАКТИРОВАТЬ: Скорректирован тип в этой строке sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1")

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")

    ' 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

End Sub

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...