VBA筛选表和结果列到剪贴板的复制子集

I am trying to automatically copy a subset of rows and columns from a source table into the clipboard for use in other applications. I am creating the filter on the header of the table and filtering the rows correctly but do not know how to then select the subset of columns in the order I want. The source table is Columns A - L and I want to copy out Columns C, I, H and F in that order to the clipboard after applying the filter. Some code (minus the copy part) is included below.

我试图自动将源表中的行和列的子集复制到剪贴板，以便在其他应用程序中使用。我正在表的标题上创建过滤器并正确过滤行，但不知道如何按我想要的顺序选择列的子集。源表是列A - L，我想在应用过滤器后按顺序将列C，I，H和F复制到剪贴板。下面包含一些代码（减去复制部分）。

Sub exportExample()
    Dim header As Range
    Dim srcCol As Range

    Set header = [A5:L5]

    header.AutoFilter
    header.AutoFilter 12, "Example", xlFilterValues

    'Copy out columns C, I, H and F of the resulting table in that order
End Sub

I can figure out how to copy the columns but can't figure out how to get them in the order I want. Any help is greatly appreciated! Thanks!

我可以弄清楚如何复制列，但无法弄清楚如何按我想要的顺序获取它们。任何帮助是极大的赞赏！谢谢！

2 个解决方案

#1

Is this what you are trying? I have commented the code so that you shouldn't have any problem understanding it.

这是你在尝试什么？我已经对代码进行了评论，因此您不应该对它有任何问题。

LOGIC:

逻辑：

1. Filter the data
2. 过滤数据
3. Create a Temp Sheet
4. 创建临时表
5. Copy filtered data to temp sheet
6. 将过滤后的数据复制到临时表
7. Delete unnecessary columns (A,B,D,E,G,J,K,L)
8. 删除不必要的列（A，B，D，E，G，J，K，L）
9. Rearrange relevant columns (C,F,H,I) TO C,I,H and F
10. 将相关列（C，F，H，I）重新排列为C，I，H和F.
11. Delete Temp Sheet in the end (IMP: Read notes at the end of the code)
12. 最后删除临时表（IMP：阅读代码末尾的注释）

CODE (Tried And Tested)

代码（经过试验和测试）

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim rRange As Range, rngToCopy As Range
    Dim lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Get the Last Row
        lRow = .Range("L" & .Rows.Count).End(xlUp).Row

        '~~> Set your range for autofilter
        Set rRange = .Range("A5:L" & lRow)

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter, copy visible rows to temp sheet
        With rRange
            .AutoFilter Field:=12, Criteria1:="Example"

            '~~> This is required to get the visible range
            ws.Rows("1:4").EntireRow.Hidden = True

            Set rngToCopy = .SpecialCells(xlCellTypeVisible).EntireRow

            Set wsTemp = Sheets.Add

            rngToCopy.Copy wsTemp.Range("A1")

            '~~> Unhide the rows
            ws.Rows("1:4").EntireRow.Hidden = False
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    '~~> Re arrange columns in Temp sheet so that we get C, I, H and F
    With wsTemp
        .Range("A:B,D:E,G:G,J:L").Delete Shift:=xlToLeft
        .Columns("D:D").Cut
        .Columns("B:B").Insert Shift:=xlToRight
        .Columns("D:D").Cut
        .Columns("C:C").Insert Shift:=xlToRight

        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rngToCopy = .Range("A1:D" & lRow)

        Debug.Print rngToCopy.Address

        '~~> Copy the range to clipboard
        rngToCopy.Copy
    End With

    'NOTE
    '
    '~~> Once you have copied the range to clipboard, do the necessary
    '~~> actions and then delete the temp sheet. Do not delete the
    '~~> sheet before that. An alternative would be to use the APIs
    '~~> to place the range in the clipboard so you can safely delete
    '~~> the sheet before performing any actions. This will not clear
    '~~> clear the range if the sheet is immediately deleted.
    '
    '

    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub

SCREENSHOT

屏幕截图

Sheet1 before the code is run

运行代码之前的Sheet1

Temp sheet with filtered data

带过滤数据的临时表

FOLLOWUP

跟进

To remove borders you can add this code to the above code

要删除边框，您可以将此代码添加到上面的代码中

With rngToCopy
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
end with

Put the above code after the line Debug.Print rngToCopy.Address

将上面的代码放在Debug.Print行rngToCopy.Address之后

#2

You will have to copy the columns out individually, as objects that refer to ranges require the cells to be in order.

您必须单独复制列，因为引用范围的对象需要单元格按顺序排列。

Something like this should work:

像这样的东西应该工作：

activeworkbook.Sheets(1).Columns("C:C").copy activeworkbook.Sheets(2).Columns("A:A")
activeworkbook.Sheets(1).Columns("I:I").copy activeworkbook.Sheets(2).Columns("B:B")
activeworkbook.Sheets(1).Columns("H:H").copy activeworkbook.Sheets(2).Columns("C:C")
activeworkbook.Sheets(1).Columns("F:F").copy activeworkbook.Sheets(2).Columns("D:D")

then you should be able to do:

那么你应该能够做到：

activeworkbook.Sheets(2).Columns("A:D").copy 

to get it to the clipboard

把它带到剪贴板