Copy dữ liệu bao gồm comment

[tranphuson]

Vui lòng giúp mình copy từ Sheet "Du lieu" + bao gồm Comment từ cột C trở đi và dán vào Sheet "KQ".

Hiện tại mình có code VBA copy qua Sheet "KQ" nhưng không chưa copy được comment ở Sheet "Du lieu".

Xin cảm ơn

 

[batman1]

Tôi không có hứng đập đi xây mới mà chỉ thêm và sửa chút. Cái sửa này chỉ giới hạn ở những chỗ BẮT BUỘC phải sửa để đồng bộ với chỗ thêm.

1. Khai báo thêm

Dim rng As Range, commentRng As Range, cell_ As Range, curr_row As Long

2. Trong With Sheets("Du lieu") thêm

Set rng = .Range("C2:AG" & eRow)

3. Sửa thành

ReDim Res2(1 To sRowRes, 1 To 3)

4. Sau dòng ReDim Res2 thì thêm

Set commentRng = rng.SpecialCells(xlCellTypeComments)
For Each cell_ In commentRng
    curr_row = (cell_.Column - 3) * sRow + cell_.Row - 1
    Res2(curr_row, 3) = cell_.Comment.Text
Next cell_

5. Sửa thành

.Range("D4").Resize(sRowRes, 3) = Res2

 

[tranphuson]

Tôi không có hứng đập đi xây mới mà chỉ thêm và sửa chút. Cái sửa này chỉ giới hạn ở những chỗ BẮT BUỘC phải sửa để đồng bộ với chỗ thêm.

1. Khai báo thêm

Dim rng As Range, commentRng As Range, cell_ As Range, curr_row As Long

2. Trong With Sheets("Du lieu") thêm

Set rng = .Range("C2:AG" & eRow)

3. Sửa thành

ReDim Res2(1 To sRowRes, 1 To 3)

4. Sau dòng ReDim Res2 thì thêm

Set commentRng = rng.SpecialCells(xlCellTypeComments)
For Each cell_ In commentRng
    curr_row = (cell_.Column - 3) * sRow + cell_.Row - 1
    Res2(curr_row, 3) = cell_.Comment.Text
Next cell_

5. Sửa thành

.Range("D4").Resize(sRowRes, 3) = Res2

Cảm ơn bạn đã hướng dẫn, mình đã làm được