VBA match, copy , paste and append

[whitesakura]

Dear All,

I am currently working on this vba, relatively new to this language.
Hope anyone can kindly advice,

I want to do as below


From the sheet1, all row data in range header sheet1 will goes accordingly to column header name in sheet2 and extra column header which <> header in sheet2 will remain in sheet2.

Let Say below is Sheet1

AA BB CC DD EE

111 112 113 114 115
end A end B end C end D end E

Then in Sheet2 has no data , only header name


AA CC CC Blank

Then after macro, it should be as.

: Sheet2 as base, then append header from Sheet1 which <> to Sheet2.
Then data from Sheet1 need to copy to Sheet2 accordingly to name header.

AA CC CC Blank BB DD EE

111 113 113 112 114 115

end A end C end C end B end D end E


Attached here is the excel file Match_Append_revised _V1.xls.
It will explain on the illustration in tab "Sample ".

However,
i already make halfway testing.. but, it did not append header and data from Sheet1.

Hopefully, some one can help me..Many thanks for your kind advice.



Sub Compare3()
Dim Sh_1 As Worksheet
Dim Sh_2 As Worksheet
Dim X As Long
Dim Z As Long
Dim Y As Long
Dim i As Integer
Dim LastRow_1 As Long
Dim LastCol_1 As Long
Dim LastRow_2 As Long
Dim LastCol_2 As Long
Dim LastCol_Differ As Long
Dim LastColExtra_2 As Long


Dim Data_1 As Variant
Dim Data_2 As Variant
Dim key As String
Dim mama As String


Dim C_1 As Range
Dim C_2 As Range
Dim cell1 As Variant
Dim DifferCollection As Collection

Set Sh_1 = ActiveWorkbook.Sheets("Sheet1")
Set Sh_2 = ActiveWorkbook.Sheets("Sheet2")
LastRow_1 = Sh_1.Range("A65535").End(xlUp).Row
LastCol_1 = Sh_1.Range("IV1").End(xlToLeft).Column

Set Data_1 = Sh_1.Range("A1").Resize(LastRow_1, LastCol_1)
LastRow_2 = Sh_2.Range("A65535").End(xlUp).Row
LastCol_2 = Sh_2.Range("IV1").End(xlToLeft).Column
Set Data_2 = Sh_2.Range("A1").Resize(LastRow_2, LastCol_2)
For Each C_1 In Data_1
For Each C_2 In Data_2



If C_2 = C_1 Then


Sh_1.Activate

Y = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

Y = Y - 1

' Y = C_1.End(xlDown).Row - 1 'kena betulkan sikit sini bila dah masuk GTR
'bcoz in sheet2 xleh ade dta langsung

Range(C_1, C_1.Offset(Y, 0)).Copy
Sh_2.Activate

C_2.Select


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If
Next C_2
Next C_1



End Sub





Thanks