VBA to Copy Selected Cells

[purceld2]

Hi There
I have looked on the internet and cannot seem to find an example of VBA copy code to do what I require.

Background

I get numerous orders sent to me on a daily basis via email which I currently manually cut and paste the relevant data into a weekly Excel spreadsheet for management. This work is very tedious and I am trying to automate the process.

I have cut and paste the table from the email into a sheet call InOrder. Now I need to get the data into the report (Financial). I have attached of the two sheets and if somebody can get me going I would be most grateful.

Another issues I have is that subsequent orders need to be added to the next free column.

Only data from InOrder that has a corresponding name needs in Financail sheet needs be copied

Thanks you in advance for any help

Excel 2010
	A	B	C	D	E
1	Weekly Report
2
3	Tuesday 28 October 2014
4
5	Job Number
6	Date Booked
7	Sales Person
8	Advertiser
9	Product
10	Network(s)
11	Agency
12	Specialist
13	Sales Agent
14	Barter
15	Agency Commission
16	Over-rider
17	Sales Agent Commission
18	Barter Company Commission
19	Category
20	Stocked Product
21
22	Gross Media Spend*
23	Gross Research
24	Agency Commission on Research Y/N
25	Gross Production
26	Agency Commission on Production Y/N
27	Screens (No)
28	Playout (Days)
29	Start Date Date
30	End Date Date
Financial

Excel 2010
	A	B
1	Agency	MEC
2	Specialist	Zone
3	Advertiser	Test
4	Product	Test 2
5	Start date	22/12/2014
6	End date	18/01/2015
7	Network(s)	Forecourt
8	Regionality
9	Screens (No)	3
10	Gross Media Spend	£2,000
11	Conditions of booking
12	Barter Agency
13	Agency Commission	15%
14	Specialist Comms	5%
15	Barter	%
16	Additional Comms	%
17	Over Rider	13%
18	Amscreen Net Net Net
19	Booking Reference	82738
20	Creative Agency
21	Creative Contact
22	Category	Retail
23	Sales Person	Sara Froud
InOrder

 

[sijpie]

Is this question still relevant? I understand that you have a number of sheets like 'InOrder' and you want to transfer the relevant information to the Financial sheet, each in a new column.

 

[purceld2]

Yes, if you have a solution, it would be most helpful

Regards

 

[sijpie]

Option Explicit


Sub TransferAgencyDetails()
    Dim wsF As Worksheet, wsIO As Worksheet
    Dim rIn As Range, rOut As Range, rFound As Range
    Dim lRIn As Long, lCOut As Long
    
    Set wsF = ThisWorkbook.Sheets("Financial")
    Set wsIO = ThisWorkbook.Sheets("InOrder")
    
    Set rIn = wsIO.Range("A1")      ' 1st cell of input table
    Set rOut = wsF.Range("A1")      ' 1st cell of column in output table holding the titles
    lCOut = wsF.Range("A5").CurrentRegion.Columns.Count ' count the number of columns populated
    
    Do While rIn.Value <> vbNullString  ' assuming no gaps in column 1 of the input table
        ' find the current title of the input tble in the output table
        Set rFound = rOut.EntireColumn.Find(what:=rIn.Value, _
                        after:=Cells(Cells.Rows.Count, 1), _
                        LookIn:=xlValues, lookat:=xlWhole, _
                        searchdirection:=xlNext, MatchCase:=False)
        If Not rFound Is Nothing Then       ' key word is found
            ' copy the value to the coressponding column in the output table
            rOut.Offset(rFound.Row - 1, lCOut).Value = rIn.Offset(0, 1).Value
        End If
        
        Set rIn = rIn.Offset(1, 0)  ' move one cell down in the input table
    Loop    'rIn.Value
    
End Sub

 

[purceld2]

Thanks sijpie
Much appreciated