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

我正在尝试从源表中将行和列的子集自动复制到剪贴板以供其他应用程序使用。 我正在表头上创buildfilter，正确过滤行，但不知道如何然后select我想要的顺序列的子集。 源表是列A – L，我想按顺序将C，I，H和F列复制到剪贴板后应用filter。 下面包含一些代码（减去复制部分）。

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 

我可以弄清楚如何复制列，但不知道如何让他们在我想要的顺序。 任何帮助是极大的赞赏！ 谢谢！

Answer 1

这是你正在尝试？ 我已经评论了代码，以便您不应该有任何理解它的问题。

逻辑 ：

1. 过滤数据
2. 创build一个临时表
3. 将过滤的数据复制到临时表单
4. 删除不必要的列（A，B，D，E，G，J，K，L）
5. 将相关列（C，F，H，I）重新排列到C，I，H和F
6. 最后删除临时表（IMP：在代码末尾读取注释）

代码（ 试验和testing ）

 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 

屏幕截图

代码运行之前的Sheet1

过滤数据的温度表

跟进

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

 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 

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

Answer 2

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

像这样的东西应该工作：

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

那么你应该可以做到：

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

把它送到剪贴板