指定要在每个Excel工作表中保存的列集

时间:2017-12-04 15:34:04

标签: excel vba excel-vba

我正在使用包含多个工作表的工作簿,我必须定期导出它们。我的工作表有数千行,使用自动过滤器我只想导出已过滤的内容和可见列。

我缺少的是一种只导出可见列和行的方法。我想我需要使用CellTypeVisible,但还没有找到如何让它在我的代码中工作:

Sub SaveAllAsTsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim Filename As String

'Get folder to save to
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Output Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    SaveToDirectory = .SelectedItems(1)
End With

'Choose which worksheets to save
For Each WS In ActiveWorkbook.Worksheets
    Select Case MsgBox("Save " & WS.Name & "?", vbQuestion + vbYesNoCancel)
        Case vbYes
            Filename = SaveToDirectory & "\" & WS.Name & ".txt"
            WS.SaveAs Filename, xlTextWindows, Local:=True
        Case vbCancel
            Exit Sub
        Case vbNo
    End Select
Next

End Sub

1 个答案:

答案 0 :(得分:0)

我发现这个效果非常好。它使用.autofilter对象的.range属性,这似乎是一个相当模糊但非常方便的功能:

Sub copyfiltered()
    ' Copies the visible columns
    ' and the selected rows in an autofilter
    '
    ' Assumes that the filter was previously applied
    '
    Dim wsIn As Worksheet
    Dim wsOut As Worksheet

    Set wsIn = Worksheets("Sheet1")
    Set wsOut = Worksheets("Sheet2")

    ' Hide the columns you don't want to copy
    wsIn.Range("B:B,D:D").EntireColumn.Hidden = True

    'Copy the filtered rows from wsIn and and paste in wsOut
    wsIn.AutoFilter.Range.Copy Destination:=wsOut.Range("A1")
End Sub