Lấy dữ liệu từ Sheet KHSX sang Sheet BAOCAO có "Merge" (1 người xem)

[lhthai]

Mình muốn lấy giữ liệu từ sheet KHSX sang Sheet BAOCAO có Merge
Các Anh Chị xem file đính kèm.

 

[Ba Tê]

Mình muốn lấy giữ liệu từ sheet KHSX sang Sheet BAOCAO có Merge
Các Anh Chị xem file đính kèm.

Chạy thử code này xem sao.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long
With Sheets("KHSX")
    sArr = .Range(.[A4], .[A4].End(xlDown)).Resize(, 4).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 10, 1 To 5)
K = -9
For I = 1 To UBound(sArr, 1)
    K = K + 10
    dArr(K, 1) = I
    For J = 1 To 4
        dArr(K, J + 1) = sArr(I, J)
    Next J
Next I
With Sheets("BAOCAO")
    .Range("A5").Resize(K, 5) = dArr
    .Range("A5:K14").Copy
    .Range("A15:K15").Resize(K - 1).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
End With
End Sub

 

[lhthai]

Cám ơn Anh Ba Tê và hpkhuong nhiều nha.