macro to move data from one sheet to another when header change positions?

[tonywatsonhelp]

Hi Everyone,

Bit stuck on this,

I have a document that i add new data every week to,
I paste the new data into Sheet "Raw Data" with the headers in Row 13, I have a macro that then checks each header exists in the document already.
(basically its weekly figures that get added to their own tab but I use the raw data tab to sort out the data so it is what I want as there's a lot a garbage that comes in with it)
anyway that all works great
the problem i'm having is sometimes the new data is in a different order so I cant just transfer the data to its final destination as the headers will be mixed up. (for reasons I cannot get anyone to explain to me )
so what I want to do is move it to its final destination sheet one column at a time putting them in the correct order.
everything is in place to do this i'm just struggling and could do with some help with the code.


so this is what I need

when the macro is run,

It Goes to tab "Raw Data"

first it gets the name of the sheet its moving to in sheet "Raw Data" Cell A1. (e.g "Feb Wk2")
The tab its moving two will always be clear of data except for the headers that are in Row 1 so it pasting into Row2

so with "Raw Data" Starting at Column A and row 13, find the column in final destination tab that has a matching name and paste the data in.

Please help if you can

Tony

 

[mumps]

Try:

Sub CopyColumn()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Raw Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = Sheets("Raw Data").Cells(13, Columns.Count).End(xlToLeft).Column
    Dim Col As Range
    Dim FoundCol As Range
    For Each Col In Sheets("Raw Data").Range(Sheets("Raw Data").Cells(13, 1), Sheets("Raw Data").Cells(13, lColumn))
        Set FoundCol = Sheets(Sheets("Raw Data").Range("A1").Value).Rows(1).Find(Col, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCol Is Nothing Then
            Sheets("Raw Data").Range(Sheets("Raw Data").Cells(14, Col.Column), Sheets("Raw Data").Cells(LastRow, Col.Column)).Copy _
                Sheets(Sheets("Raw Data").Range("A1").Value).Cells(2, FoundCol.Column)
        End If
    Next Col
    Application.ScreenUpdating = True
End Sub

 

[tonywatsonhelp]

Thanks Mumps looks good to me
That's great
Tony

 

[mumps]

My pleasure.