Фильтрация таблицы, экспорт определенных заголовков столбцов и диапазона столбцов в CSV и сохранение

Копирование определенных столбцов из таблицы Excel в новую книгу

• Используйте Option Explicit вверху каждого модуля. Это заставит вас объявить все переменные (Dim, Const), но сэкономит вам много времени, например. поиск опечаток перед запуском.
• Избегайте использования Select и любых разновидностей Active. Они часто ненадежны и замедляют работу кода.
• Вместо этого используйте константы и переменные и ссылайтесь на объекты, чтобы сделать код более читабельным.

Источник

• В моем случае таблица FieldOps находится на листе Sheet1 и начинается в ячейке D6, что иллюстрирует гибкость кода.

Пункт назначения после линии srg.Copy dcell

Конечный пункт назначения (без форматирования из-за .csv)

Option Explicit

Sub ExportNewReps()
    
    ' Define constants.
    
    ' These two need to be in 'sync'.
    Const DST_FILE_NAME As String = "O365_FieldOps_Import.csv"
    Const DST_FILE_FORMAT As Long = xlCSV
    
    ' Reference the source objects (workbook, worksheet, range...).
     
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    ' If it's not, use the following instead.
    'Dim swb As Workbook: Set swb = Workbooks("FieldOps.xlsm")

    ' Assuming you don't know the name of the worksheet containing the table.
    Dim slo As ListObject: Set slo = Application.Range("FieldOps").ListObject
    Dim sws As Worksheet: Set sws = slo.Parent
    ' Otherwise, use the following instead.
    'Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    'Dim slo As ListObject: Set slo = sws.ListObjects("FielOps")
    
    ' Reference the source worksheet columns to use with 'Intersect'
    ' to copy the required columns only.
    
    Dim scrg As Range: Set scrg = slo.Range.Range("B1:E1,M1:N1").EntireColumn
    ' i.e. reference the 2nd to 5th and the 14th to 15th TABLE column
    ' i.e. if the table start in column 'C', it means 2 columns
    ' to the right on the WORKSHEET.
    ' Move the table around and return the range address in the
    ' Immediate window (Ctrl+G) with...
    Debug.Print scrg.Address(0, 0)
    ' ... to better understand what the previous means.

    ' Reference the source range, the range to be copied.
    
    Dim srg As Range
    
    With slo
        ' Clear table filters.
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
        ' Filter.
        .Range.AutoFilter Field:=1, Criteria1: = "<>" ' non-blanks in col 1
        ' Reference the correct range.
        Set srg = Intersect(scrg, .Range.SpecialCells(xlCellTypeVisible))
        ' Clear table filters again.
        .AutoFilter.ShowAllData
    End With
    
    ' Reference the destination objects (workbook, worksheet, range...).
    
    ' Add a single-worksheet ('xlWBATWorksheet') workbook.
    Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet)
    Dim dws As Worksheet: Set dws = dwb.Sheets(1) ' the one and only!
    Dim dcell As Range: Set dcell = dws.Range("A1")
    
    ' Copy.
    
    srg.Copy dcell
    
    ' Save and close.
    
    Dim dFilePath As String:
    dFilePath = swb.Path & Application.PathSeparator & DST_FILE_NAME
    
    Application.DisplayAlerts = False
    ' i.e. overwrite without confirmation, don't show the dialog
    ' if different file format,...
        dwb.SaveAs Filename:=dFilePath, FileFormat:=DST_FILE_FORMAT
    ' if your list separator isn't the default comma, you might try to append
    ' ', Local:=True' to the previous line for the file to open correctly.
    Application.DisplayAlerts = True
     
    dwb.Close SaveChanges:=False ' just got saved

    ' Inform.

    MsgBox "New reps exported.", vbInformation

End Sub