Ghép dữ liệu 2 sheet lại thành 1 sheet nhưng thể hiện bằng 2 dòng (1 người xem)

[Excel365]

Em có 2 sheet dữ liệu 1 va 2 (1 nguoi nhung co du lieu o 2 sheet). Nay em muốn ghép từ 2 sheet đó lại thành 1, những dữ liệu sẽ thể hiện bằng 2 dòng. (Một người thể hiện bằng 2 dòng).
Trong file em có ví dụ kết quả mong muốn
Nhờ các anh chị giúp em . Trân trọng cảm ơn
https://drive.google.com/file/d/0Bz23-2tBuYb1ZU96em1uSXR1Znc/view?usp=sharing

 

[Ba Tê]

Em có 2 sheet dữ liệu 1 va 2 (1 nguoi nhung co du lieu o 2 sheet). Nay em muốn ghép từ 2 sheet đó lại thành 1, những dữ liệu sẽ thể hiện bằng 2 dòng. (Một người thể hiện bằng 2 dòng).
Trong file em có ví dụ kết quả mong muốn
Nhờ các anh chị giúp em . Trân trọng cảm ơn
https://drive.google.com/file/d/0Bz23-2tBuYb1ZU96em1uSXR1Znc/view?usp=sharing

Viết cho bạn code ghép 2 bảng, còn chuyện Merge Cells hay kẻ khung bạn tự chế thêm nhé.

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, Rws As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("1")
    .[A5:AK5].Copy Sheets("Ghep").[A5]
    sArr = .Range(.[A6], .[D65536].End(xlUp)).Resize(, 37).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 37)
For I = 1 To UBound(sArr, 1)
    K = K + 1
    For J = 1 To 37
        dArr(K, J) = sArr(I, J)
    Next J
    If sArr(I, 1) <> Empty Then
        K = K + 1
        Dic.Item(sArr(I, 2)) = K
    End If
Next I
With Sheets("2")
    sArr = .Range(.[A6], .[D65536].End(xlUp)).Resize(, 37).Value
End With
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 2)
    If Dic.Exists(Tem) Then
        Rws = Dic.Item(Tem)
        For J = 7 To 37
            dArr(Rws, J) = sArr(I, J)
        Next J
    End If
Next I
Sheets("Ghep").[A6].Resize(K, 37) = dArr
Set Dic = Nothing
End Sub

 

[Ba Tê]

Hình như anh Ba Tê có 1 sự nhầm lẫn nhẹ. Chắc là chữ GPE nó thâm sâu trong đầu rồi.........hehe

 [COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]A5[/FONT][/COLOR][COLOR=#007700][FONT=monospace]:[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]AK5[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Copy Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][B][COLOR=#DD0000][FONT=monospace]"GPE"[/FONT][/COLOR][/B][COLOR=#007700][FONT=monospace]).[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]A5[/FONT][/COLOR][COLOR=#007700][FONT=monospace]]  [/FONT][/COLOR]

Đúng rồi. Khi tôi làm thì làm trên sheet tạm tên GPE, sau khi chạy ổn mới chỉnh lại cho sheet Ghep mà "sót", sửa chưa hết.