2

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. 

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!

user1651899
  • 55
  • 2
  • 2
  • 4
  • you may have to copy them column-by-column into the order you want on another area of the sheet (or a new sheet), then copy that whole range. – Scott Holtzman Sep 06 '12 at 16:01

2 Answers2

2

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. Create a Temp Sheet
  3. Copy filtered data to temp sheet
  4. Delete unnecessary columns (A,B,D,E,G,J,K,L)
  5. Rearrange relevant columns (C,F,H,I) TO C,I,H and F
  6. Delete Temp Sheet in the end (IMP: Read notes at the end of the code)

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

enter image description here

Temp sheet with filtered data

enter image description here

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

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • This works well, thanks! I'll need to modify the code to strip off some of the formatting (borders from the table) but I should be able to figure it out. Would it be a quick change to not copy the header row to the temporary worksheet? – user1651899 Sep 06 '12 at 17:09
  • Change this `rngToCopy.Copy wsTemp.Range("A1")` to `rngToCopy.Copy` and in the next line put this `wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False` – Siddharth Rout Sep 06 '12 at 17:12
  • Disregard that last comment, I figured out how to change the code to do that. Thanks again for the help!!! – user1651899 Sep 06 '12 at 17:12
  • Well, that line turns the dates into integers. – user1651899 Sep 06 '12 at 17:15
  • Do you want to just remove the borders or any other formatting as well? – Siddharth Rout Sep 06 '12 at 17:17
  • Just the borders. Everything else is fine. – user1651899 Sep 06 '12 at 17:20
0

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

SeanC
  • 15,695
  • 5
  • 45
  • 66