Giúp đỡ copy dữ liệu từ nhiều sheet theo điều kiện từ sheet khác (1 người xem)

[nhnn1986]

Chào các bạn:

Mình có 01 file excel với 04 sheet A, B, C và D. Tại sheet B và C có dữ liệu với cột A chứa thông tin lọc dạng: 201601, 201602..... 201701, 201702..... 201801,201802 ....

Mình muốn tại địa chỉ A1 sheet A gõ "2016" thì tất cả các hàng dữ liệu tại sheet B, C có thông tin dạng "**2016**" sẽ được copy sang sheet D.

Mình sưu tầm được Code dưới đây nhưng nó chỉ copy Sheet B sang D, không copy từ Sheet C sang D như mình mong muốn.

Nhờ các bạn giúp đỡ sửa code ạ.

Đây là đoạn code của mình và đính kèm file cho dễ hình dung.

Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("D").Cells.Clear
Dim lngRowB As Long, lngRowC As Long, lngRowD As Long
Dim wksB As Worksheet, wksC As Worksheet, wksD As Worksheet
Dim rngB As Range, rngC As Range, cel As Range

    If Target.Address = "$A$1" Then
        If Len(Trim(Target.Value)) = 4 Then
            
            Set wksB = ThisWorkbook.Worksheets("B")
            Set wksC = ThisWorkbook.Worksheets("C")
            Set wksD = ThisWorkbook.Worksheets("D")
            
            lngRowB = wksB.Range("A" & Rows.Count).End(xlUp).Row
            lngRowC = wksC.Range("A" & Rows.Count).End(xlUp).Row
            lngRowD = wksD.Range("A" & Rows.Count).End(xlUp).Row
            
            Set rngB = wksB.Range("A1:A" & lngRowB)
            Set rngC = wksB.Range("A1:A" & lngRowC)
            
            For Each cel In rngB
                If InStr(1, cel.Value, Target.Value, vbTextCompare) = 1 Then
                    lngRowD = lngRowD + 1
                    cel.EntireRow.Copy Destination:=wksD.Cells(lngRowD, 1)
                End If
            Next cel
            For Each cel In rngC
                If InStr(1, cel.Value, Target.Value, vbTextCompare) Then
                    lngRowD = lngRowD + 1
                    cel.EntireRow.Copy Destination:=wksD.Cells(lngRowD, 1)
                End If
                            
            Next cel
        Else
            MsgBox ("hay nhap vao 04 chu so.")
        End If
        
    End If
End Sub