whitesakura
02-14-2011, 07:52 PM
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
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