@ Jayant shettigar
Hi Jayant shettigar
. I was working on a code for you as Jacc posted his great code..
. As I had almost finished I thought I would still give my alternative.
.
. There are infinite ways to do your requirement, mine is based on a previous solution I gave here, ( where there are some more detailed explanations of what is going on. )
http://www.mrexcel.com/forum/excel-q...l?#post4174322
.
. I give you two codes, basically the same, the first simplified, the second opened up and with explaining Green comments

. I modified my first simplified code to include the Timer part from Jacc as a further comparison. ( And also to run it needs you to the make those changes to the programming names of the worksheet in manually as Jacc explained in Post #5 )
. My codes are almost as fast as Jacc’s
Codes:

'Option Explicit'This must be commented out for simplified Code
Sub CopyColumnsAlanSHimpfGlified()

Dim arrin() As Variant: Let arrin() = Dump.Range("A2:AK" & Dump.Cells(Rows.Count, 1).End(xlUp).Row).Value
Let arrin(1, 37) = "Cleared"

t = Timer
Application.ScreenUpdating = False

    Dim c() As Variant: Let c() = Array("1", "6", "4", "13", "35", "36", "37", "19", "28", "15", "2", "3"): Let c() = Application.WorksheetFunction.Transpose(c())
       For iii = LBound(arrin(), 1) To UBound(arrin(), 1)
           Let strRows = strRows & " " & iii
       Next iii
    Dim outArr() As Variant: outArr() = Application.WorksheetFunction.Transpose(Application.Index(arrin(), Split(Trim(strRows), " "), c()))
    
    Output.Range("A2").Resize(UBound(outArr(), 1), UBound(outArr(), 2)) = outArr()

Application.ScreenUpdating = True
t = Timer - t
MsgBox "It took " & t & "seconds"
End Sub
'
'
'
'
'
'
'




Sub CopyColumnsAlan()
' 1) Get Initial Data
Dim wsDump As Worksheet, wsOut As Worksheet 'Give Abbreviation Methods, Properties of Object Worksheet through .dot
Set wsDump = ThisWorkbook.Worksheets("Dump"): Set wsOut = ThisWorkbook.Worksheets("Output")
Dim lr As Long, lc As Long 'Variable for, last Row, last Column of  sheet1. Assume our File for Input has a reasonably well defined end. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.
Let lc = 36: Let lr = wsDump.Cells.Find(What:="*", After:=wsDump.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Get last Row with entry anywhere for Sheet1. Method: You start at first cell then go backwards (which effectively starts at end of sheet), searching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method that finds last row in sheet rather than row for last entry in particular cell. Better to use that here as we are not sure which columns are full
Let lc = lc + 1 'Include an extra column, assume that column is empty
Dim arrin() As Variant: Let arrin() = wsDump.Range(wsDump.Cells(2, 1), wsDump.Cells(lr, lc)).Value  'Allowed VBA One Liner - An Array of variants may be set to a collection of Range values. The Range object works as to return a collection of (Variants initially) of various types. So Initially must see an Array of Variant types for compatability
Let arrin(1, lc) = "Cleared" 'Extra heading in last "Column" in Array


' 2) We could include a part here to make the output be made dynamic to extract the column based on the column heading
' -  this would involve an alternative way to get at c()

' 3 )obtain an Array of indicies for required output columns and all "row" indices from array arrin()
    Dim c() As Variant: Let c() = Array("1", "6", "4", "13", "35", "36", "" & lc & "", "19", "28", "15", "2", "3"): Let c() = Application.WorksheetFunction.Transpose(c())
    Dim iii As Long, strRows As String 'Loop Bound (Count) Variable and tempoary sting for row indicies
       For iii = LBound(arrin(), 1) To UBound(arrin(), 1) 'Lower Bound by me is header
           Let strRows = strRows & " " & iii 'Concatenating valid "row" indicies
       Next iii
        Let strRows = Trim(strRows) 'trim off first space
    Dim r() As String: Let r() = Split(strRows, " ")
    Dim outArr() As Variant 'I believe here the Index is working in some "vector" type form here. VBA "works" as follows here:
        Let outArr() = Application.Index(arrin(), r(), c()) 'It takes in turn each of the indicies in rws()
'        'and for each of these it steps through the indicies in clms(). It returns then effectively a "column" of values.
'        ' These values are then the entities in the main Array arrin() given by those co-ordinates. In our case then, we initially put into the new Array y(), a column which contains the first data row.
        Let outArr() = Application.WorksheetFunction.Transpose(outArr()) '...As this process is then repeated for all the indicies given in  rws() we effectively have an Array  y() of our required output rows , but transposed. ( so we transpose it back to the correct orientation! )
    
' 3 ) Output Array with required Columns, and Rows out to Output Sheet
    Let wsOut.Range("A2").Resize(UBound(outArr(), 1), UBound(outArr(), 2)) = outArr() 'Simple neat allowed VBA one liner to assign values in an Array to a spreadsheet Range: Resize top left of output range to size of outout array and make it = th that Array

End Sub
. Alan