How to Create Macro to Search, Copy, & Paste?

I have Two Excel sheets Sheet2: Database file(Row wise Data has been updated i.e only in A column- refer below

HTML Code: 

Sheet1: MIS Report (with the heading of the columns).

In Sheet1 -i have populated the headings like Name , Company, city etc.

HTML Code: 

Macro Requirement :

So here,i wanted to create a macro to search for all the same heading names and copy the next row data and paste into under respective headings in Sheet 1

Please do let me know if you have any questions on the same and Thanks a ton in Advance.

Example references :

Sheet 2 : Data (A) - looks like as below


Name
Arun
Company
XXXX
Title
Business Team





City
LONDON
Telephone


State
LONDON
Mobile


Country
United Kingdom
Email



Area of responsibility
Sales
Business focus
Securities
Name Vijay Company XXXX Title Business Team

City
LONDON
Telephone


State
LONDON
Mobile


Country
United Kingdom
Email



Area of responsibility
Sales
Business focus
Securities

1. Like this i have 20000 rows in a A column , here now i wanted to search in a "Sheet2" with the heading name of Sheet1 (Ex :Name,Company )
copy the next row data and paste into sheet1 under respective headings

3.we should do Find NEXT until we copied all the data
Here is the Macro code that i have recorded

Sheets("Sheet2").Select
 Range("A1").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("A37").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    ActiveSheet.Paste

Sheets("Sheet1").Select
Application.CutCopyMode = False
Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
Range("A71").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A3").Select
ActiveSheet.Paste

Note: There are few blanks rows in between(Sheet1)

I have no idea how to create a macro however i have searched all over the internet to find one that i could modify to insert my own data, and this is what ive come up with.

Please help.

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

Try this:

Sub foo()
    Dim lRow As Long, lEndRow As Long, lPasteRow As Long, lPasteCol As Long
    Dim wsSrc As Worksheet, wsTgt As Worksheet, c As Range, v As Variant

    Set wsSrc = Worksheets("Sheet2")
    Set wsTgt = Worksheets("Sheet1")

    lPasteRow = wsTgt.Cells(Rows.Count, 1).End(xlUp).Row
    With wsSrc
        lEndRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For lRow = 1 To lEndRow
            If .Cells(lRow, 1).Value = "Name" Then lPasteRow = lPasteRow + 1
            v = .Cells(lRow, 1).Value
            Set c = wsTgt.Range("1:1").Find(v)
            If Not c Is Nothing And Not v = "" Then
                wsTgt.Cells(lPasteRow, c.Column).Value = .Cells(lRow + 1, 1).Value
            End If
        Next lRow
    End With
End Sub

Happy to help.

Don't forget to mark the thread solved, and add reputation to helpful posts.

Ah yes, it's including partial matches, so it matches "NY" with "CompaNY" :D

Easy to fix - change this line:

Set c = wsTgt.Range("1:1").Find(what:=v, lookat:=xlWhole)