How to copy non contiguous columns and copy everything except first 2 and last 1 row without cut?Cutting takes long time when there is a lot of rows

Question

How to copy non contiguous columns and copy everything except first 2 and last 1 row without cut?Cutting takes long time when there is a lot of rows. I reorder an after copy.I want to copy without reordering for example copy columns c,a,h,f,o,l everything except first 2 and last 1 row

Columns("F:F").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("F:F").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("T:T").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll Down:=69
ActiveWindow.LargeScroll Down:=-4
Range(Range("C3"), Range("I3").End(xlDown).Offset(-1, 0)).Select
Selection.Copy

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, Oct 30 '19 at 12:56
Yes,i reorder an after copy.I want to copy without reordering for example columns c,a,h,f everything except first 2 and last 1 row — aaa, Oct 30 '19 at 13:20
I'm presuming you are new to VBA? Short of writing the code for you (which might not make too much sense), apart from what @Pᴇʜ suggested, it might be worth doing a course on VBA — Zac, Oct 30 '19 at 14:54
TL;DR - are you overwriting columns, i.e. all columns other than C,A,H,F and O resulting in these five columns left? — T.M., Oct 30 '19 at 19:17

score 0 · Answer 1 · answered Oct 31 '19 at 17:50

Rearranging columns via Application.Index() function

This fast approach doesn't copy individual ranges, but uses arrays instead and demonstrates the advanced possibilities of the Application.Index() function allowing to rearrange the internal rows & columns structure by one single code line (~> see section [3] in the procedure Sub Rearrange() below).

This solution assumes that you want a new columns order consisting only of the five (original) data columns C,A,H,F and O, thus deleting all not included columns - but you can easily change the constant NEWCOLUMNORDER to any other combination, if you want to include further or all columns.

Main procedure Rearrange


Sub ReArrange()
With Sheet1             ' using the CodeName of a sheet, see (Name) in Property Tool Window
  Const NEWCOLUMNORDER As String = "C,A,H,F,O"
  ' [0] Define data range as well as first and last row (checking e.g. column A:A)
    Dim firstRow As Long, lastRow As Long
    firstRow = 3: lastRow = .Range("A" & .Rows.count).End(xlUp).Row
    Dim rng As Range
    Set rng = .Range("A" & firstRow & ":O" & lastRow - 1) ' start from 3rd row
  ' [1] assign data values to (1-based) 2-dimensional variant array
    Dim v As Variant
    v = rng.Value2
  ' [2] empty original data range (omitting last row)
    rng.Resize(lastRow - firstRow).Clear
  ' [3] Rearrange array rows & columns
    v = Application.Index(v, _
        Evaluate("row(1:" & lastRow - firstRow & ")"), _
        ColNos(NEWCOLUMNORDER))
  ' [4] Write array back to range
    rng.Resize(UBound(v), UBound(v, 2)) = v
End With
End Sub

Note that I prefer to use a sheet's unique CodeName associated to your VBA project (~> see the code line With Sheet1) avoiding for instance issues after sheets being renamed via sheet tab (by default starting with identical Name as its CodeName in the VBE Window with (Name) in brackets!). Of Course it's possible to refer to e.g. With ThisWorkbook.Worksheets("Sheet1") too.

Helper function ColNos()

Function ColNos(ByVal s, Optional ByVal DELIM$ = ",") As Variant()
'Purpose: return array of column numbers
'Example: "C,A,H,F,O" ~~> Array(3,1,8,6,15)
s = Split(s, DELIM)         ' split string into individual column letters
ReDim tmp(0 To UBound(s))   ' define array's (1st) dimension via array indices
Dim i&                      ' zero based items counter
For i = 0 To UBound(s)      ' loop through column letters, e.g. C,A,H,F,O
    tmp(i) = Columns(s(i) & ":" & s(i)).Column ' get column number
Next i
ColNos = tmp                ' return temporary array items
End Function

How to copy non contiguous columns and copy everything except first 2 and last 1 row without cut?Cutting takes long time when there is a lot of rows

1 Answers1