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:

Reviewed by	PACE	Client Name	Sub Engaging Parties	DUNS Number	GFIS Client ID
ABCD	23200176	ITWORX EUROPE LIMITED	ITWORX LIMITED	2783738	6656
ABC	23210789	SPOTIFY LIMITED	SPOTIFY LIMITED		39028
AB	23210785	SPOTIFY LIMITED	SPOTIFY FINANCE	673526	7387

<tbody>
</tbody>

How the next sheet looks like:

Reviewed by	PACE	Client Name	DUNS Number

<tbody>
</tbody>

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.