S
Seeker
I have two sheets in the same workbook, sht 1 and sht 2.
Sht 1 (with comments in each cell of Col D)
Col D Col F
1,000 aa
500 bb
30 rr
800 aa
Sht 2 Col A to R in row 1 as heading
Col A Col B Col C… Col R
aa bb cc rr
If sht 1 Col F match heading in sht 2, append amount together with comment
to the same column in sht 2
Result
Col A Col B Col C… Col R
aa bb cc rr
1,000 500 30
800
I have following code done to append amount but cannot paste with comment
together, also it is too long as I need to set 17 “if†(from col a to col r).
Any suggestion?
Sheets("sht 1").Select
Lastrow = Range("F" & Rows.Count).End(xlUp).Offset(0, 0).Row
Range("F" & Lastrow).Select
If Range("F"&Lastrow) = "aa" Then
Lastrow = Range("D" & Rows.Count).End(xlUp).Offset(0, 0).Row
Range("D" & Lastrow).Select
Selection.Copy
Sheets("sht 2").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.Paste ‘I also tried ActiveSheet.Paste ,
Selection.PasteSpecial but all cannot copy with comment
Else
Sheets("sht 1").Select
Sht 1 (with comments in each cell of Col D)
Col D Col F
1,000 aa
500 bb
30 rr
800 aa
Sht 2 Col A to R in row 1 as heading
Col A Col B Col C… Col R
aa bb cc rr
If sht 1 Col F match heading in sht 2, append amount together with comment
to the same column in sht 2
Result
Col A Col B Col C… Col R
aa bb cc rr
1,000 500 30
800
I have following code done to append amount but cannot paste with comment
together, also it is too long as I need to set 17 “if†(from col a to col r).
Any suggestion?
Sheets("sht 1").Select
Lastrow = Range("F" & Rows.Count).End(xlUp).Offset(0, 0).Row
Range("F" & Lastrow).Select
If Range("F"&Lastrow) = "aa" Then
Lastrow = Range("D" & Rows.Count).End(xlUp).Offset(0, 0).Row
Range("D" & Lastrow).Select
Selection.Copy
Sheets("sht 2").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.Paste ‘I also tried ActiveSheet.Paste ,
Selection.PasteSpecial but all cannot copy with comment
Else
Sheets("sht 1").Select