automated copying of select columns to new worksheet - excel

Question

Am fairly new to excel and was wondering if there is an easier way to do a routine cut copy paste I do. I have a worksheet that has a long list of columns which looks like following:
Name Age Occupation Major WorkEx Position.....
I want the macro to copy some predetermined columns from worksheet 1 to worksheet 2 i.e each time I copy raw data into worksheet 1 worksheet 2 should be auto-populated with the selected columns. In this case for example,if I paste the aforementioned columns into worksheet 1, then Name, Major and Position should automatically be copied to worksheet 2.
A point to note is that the raw data is not always in order as shown above. I believe the key is to locate/find the header and then copy the entire column on to worksheet 2 on specific columns.
In this case worksheet 2 will always have Col 8-10 and Col 16 as blank.
Would anyone be able to help me with this issue? Let me know if any additional details are necessary.

Answer 1

Try this.. Just replace test1 with your column names, etc.
Remember to add the column number instead of targetCol as you want to hardcode it. I used the range object to copy data.
Option Explicit
Sub CopyCode()
'Declaring the variable lColumn as long to store the last Column number
Dim lColumn As Long
'Declaring the variable iCntr as long to use in the For loop
Dim iCntr As Long
Dim lastRow As Long
Dim lastCol As Long, targetCol As Long
Dim wks As Worksheet, targetWks As Worksheet
Dim rng As Range
Dim fCol As String
' Set wks so it is the activesheet
Set wks = ThisWorkbook.Sheets("Sheet1")
Set targetWks = ThisWorkbook.Sheets("Sheet2")
lastCol = wks.Cells(1, wks.Columns.Count).End(xlToLeft).Column
'Assigning the last Column value to the variable lColumn
lColumn = lastCol
'Using for loop
For iCntr = lColumn To 1 Step -1
If LCase(wks.Cells(1, iCntr)) Like LCase("Test1") Then
' Find column letter
fCol = GetColumnLetter(iCntr)
lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row
' Declare range object
Set rng = wks.Range(fCol & "2:" & fCol & lastRow)
' Use Range object to copy data
rng.Copy _
Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
End If
If LCase(wks.Cells(1, iCntr)) Like LCase("Test2") Then
' Find column letter
fCol = GetColumnLetter(iCntr)
lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row
' Declare range object
Set rng = wks.Range(fCol & "2:" & fCol & lastRow)
' Use Range object to copy data
rng.Copy _
Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
End If
If LCase(wks.Cells(1, iCntr)) Like LCase("Test") Then
' Find column letter
fCol = GetColumnLetter(iCntr)
lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row
' Declare range object
Set rng = wks.Range(fCol & "2:" & fCol & lastRow)
' Use Range object to copy data
rng.Copy _
Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
End If
' etc etc
Next
End Sub
Function GetColumnLetter(colNum As Long) As String
Dim vArr
vArr = Split(Cells(1, colNum).Address(True, False), "$")
GetColumnLetter = vArr(0)
End Function