Liệt kê dữ liệu khác nhau giữa nhiều sheet

Liên hệ QC

bosscomhcvp

Thành viên mới
Tham gia
24/8/18
Bài viết
21
Được thích
0
Chào các anh/chị
Em muốn liệt kê ra các mã khách hàng khác nhau giữa các sheet:
- Tổng hợp: Cần kê các mã KH có trong DS1 mà k có trong DS2, có trong DS2 mà k có trong DS3, ...
- Sheet KHRB: cần kê thông tin của các khách hàng chỉ xuất hiện trong sheet này mà các sheet khác không có
Em đã dùng công thức nhưng không làm được. Phiền các anh/chị giúp em ạ.
 

File đính kèm

Chào các anh/chị
Em muốn liệt kê ra các mã khách hàng khác nhau giữa các sheet:
- Tổng hợp: Cần kê các mã KH có trong DS1 mà k có trong DS2, có trong DS2 mà k có trong DS3, ...
- Sheet KHRB: cần kê thông tin của các khách hàng chỉ xuất hiện trong sheet này mà các sheet khác không có
Em đã dùng công thức nhưng không làm được. Phiền các anh/chị giúp em ạ.
xem thử đúng ý chưa?

Mã:
Sub Home()
Dim sh As Worksheet, Lr As Long, i As Long
Sheets("HOME").Range("A5:H50").ClearContents
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "HOME" Then
    Lr = sh.[B5].CurrentRegion.Rows.Count
        If Lr > 6 Then
            sh.Range("B6:B" & Lr).Copy (Sheets("HOME").Range("B" & Sheets("HOME").Cells(Rows.Count, "B").End(xlUp).Row + 1))
            sh.Range("C6:C" & Lr).Copy (Sheets("HOME").Range("C" & Sheets("HOME").Cells(Rows.Count, "C").End(xlUp).Row + 1))
            sh.Range("D6:D" & Lr).Copy (Sheets("HOME").Range("D" & Sheets("HOME").Cells(Rows.Count, "D").End(xlUp).Row + 1))
            sh.Range("H6:H" & Lr).Copy (Sheets("HOME").Range("F" & Sheets("HOME").Cells(Rows.Count, "F").End(xlUp).Row + 1))
            For i = 6 To Lr
                If sh.Range("B" & i).Value > 0 Then
                    sh.Range("B" & i).Offset(0, 14).Value = sh.Name
                End If
            Next i
            sh.Range("P6:P" & Lr).Copy (Sheets("HOME").Range("E" & Sheets("HOME").Cells(Rows.Count, "E").End(xlUp).Row + 1))
            sh.Range("P6:P" & Lr).ClearContents
        End If
    End If
Next sh
Sheets("HOME").Range("A5:H50").Borders.LineStyle = xlContinuous
End Sub
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom