Dynamic selection of column by header name and pasting the whole data into next sheet

[Switto]

Dear All,

I am working on an excel sheet which has 14 to 15 columns ofdata and I would like to copy some of the columns (according to the headername) and paste it to the next sheet. Sample below:
[TABLE="width: 449"]
<tbody>[TR]
[TD="width: 64"]Reviewed by
[/TD]
[TD="width: 84"]PACE[/TD]
[TD="width: 156"]Client Name [/TD]
[TD="width: 160"]Sub Engaging Parties[/TD]
[TD="width: 72"]DUNS Number[/TD]
[TD="width: 64"]GFIS Client ID[/TD]
[/TR]
[TR]
[TD="width: 64"]ABCD[/TD]
[TD="width: 84"]23200176[/TD]
[TD="width: 156"]ITWORX EUROPE LIMITED[/TD]
[TD="width: 160"]ITWORX LIMITED[/TD]
[TD="width: 72"]2783738[/TD]
[TD="width: 64"]6656[/TD]
[/TR]
[TR]
[TD="width: 64, bgcolor: transparent"]ABC[/TD]
[TD="width: 84, bgcolor: transparent"]23210789[/TD]
[TD="width: 156, bgcolor: transparent"]SPOTIFY LIMITED[/TD]
[TD="width: 160, bgcolor: transparent"]SPOTIFY LIMITED[/TD]
[TD="width: 72, bgcolor: transparent"][/TD]
[TD="width: 64, bgcolor: transparent"]39028[/TD]
[/TR]
[TR]
[TD="width: 64"]AB[/TD]
[TD="width: 84"]23210785[/TD]
[TD="width: 156"]SPOTIFY LIMITED[/TD]
[TD="width: 160"]SPOTIFY FINANCE [/TD]
[TD="width: 72"]673526[/TD]
[TD="width: 64"]7387[/TD]
[/TR]
</tbody>[/TABLE]

How the next sheet looks like:
[TABLE="width: 286"]
<tbody>[TR]
[TD="width: 74"]Reviewed by
[/TD]
[TD="width: 83"]PACE[/TD]
[TD="width: 154"]Client Name [/TD]
[TD="width: 71"]DUNS Number[/TD]
[/TR]
[TR]
[TD="width: 74"]
[/TD]
[TD="width: 83"]
[/TD]
[TD="width: 154"]
[/TD]
[TD="width: 71"]
[/TD]
[/TR]
[TR]
[TD="width: 74, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 154, bgcolor: transparent"]
[/TD]
[TD="width: 71, bgcolor: transparent"]
[/TD]
[/TR]
[TR]
[TD="width: 74"]
[/TD]
[TD="width: 83"]
[/TD]
[TD="width: 154"]
[/TD]
[TD="width: 71"]
[/TD]
[/TR]
</tbody>[/TABLE]

My problem is the data columns changes every day i.e nextday while pulling the report, client name and data which is in column C would comein column B or E. Hence, I cannot give static code to copy the data. Please seethe below code which was written:
WS1.Cells.Find(what:="Engagement Manager").Select
ActiveCell.Offset(1, 0).Select
FC = ActiveCell.Column
I have tried in different forum and I am new to VBA codingas well.
Please guide me to copy the data till the last row.
Warm Regards
Switto

 

[GR00007]

This is how I found a column when the source files were not consistent.
- set variables
vSourceName = workbook name of source file
vSaveName = workbook name of file to save
vLR = Last Row of source file
Note: The On Error was left active because there were further columns to find and paste, it was turned off after last column was found.

Windows(vSourceName).Activate
Rows("1:1").Select
On Error Resume Next
Selection.Find(What:="COLUMN_NAME<column name="">", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If Err.Number = 0 Then
vCol = Split(Cells(1, ActiveCell.Offset(0, 0).Column).Address(True, False), "$")(0) '<-- Obtain column of found cell
Range(vCol & "1:" & vCol & vLR).Select
Application.CutCopyMode = False
Selection.Copy
Windows(vSaveName).Activate
Range("A1<cell to="" paste="">").Select '<-- which ever cell you want to paste to
<cell to="" paste").select
ActiveSheet.Paste
Else
MsgBox "COLUMN_NAME not found<column name=""><column name="">"
Err.Clear
End If

Note2: When the above code was wrapped with CODE tags rows were deleted (most of the else statement) - sorry for the code format.</column></column></cell></cell></column>

 

[MickG]

Try this:-
This code should find the 4 headers required in row(1)
Place the specific columns in array "Ray" and post the results on sheet 2 Starting "A1".

[COLOR="Navy"]Sub[/COLOR] MG18Dec44
[COLOR="Navy"]Dim[/COLOR] oHds [COLOR="Navy"]As[/COLOR] Variant, H [COLOR="Navy"]As[/COLOR] Variant, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, nRay [COLOR="Navy"]As[/COLOR] Variant
oHds = Array("Reviewed by", "PACE", "Client Name", "DUNS Number")
Ray = ActiveSheet.UsedRange
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] H [COLOR="Navy"]In[/COLOR] oHds
    Num = Application.Match(H, Range("1:1"), 0)
    Txt = Txt & IIf(Txt = "", Num, "," & Num)
[COLOR="Navy"]Next[/COLOR] H
Ray = Application.Index(Ray, Evaluate("Row(1:" & UBound(Ray, 1) & ")"), Array(Split(Txt, ",")))
Sheets("Sheet11").Range("A1").Resize(UBound(Ray, 1), 4).Value = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Switto]

Thank you for the quick reply . I will try this out tomorrow morning. Almost Midnight here.

 

[Switto]

Thank GR00007 for the code..It is working for me.

 

[Switto]

Thanks for the code. I am getting “run time error 13 – type mismatch”in the following line


Ray = Application.Index(Ray, Evaluate("Row(1:"& UBound(Ray, 1) & ")"), Array(Split(Txt, ",")))


I had made required changes however got the above error.


Due to time constrain, I have used GR00007 code.


I really appreciate your quick post.

Warm Regards
Switto

 

[MickG]

No problem , thank for the reply.