Copy data to new sheet on meeting criteria

[css0911]

Dear All

Please help me in this scenario.

I have a master data sheet. Sample as below.

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Input Date[/TD]
[TD]20/01/2018[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Sr.No.[/TD]
[TD]Emp. Name[/TD]
[TD]Gate1[/TD]
[TD]Gate2[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]1[/TD]
[TD]Thomas[/TD]
[TD]20/01/2018[/TD]
[TD]01/02/2018[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]2[/TD]
[TD]Bobby`[/TD]
[TD]10/03/2018[/TD]
[TD]20/01/2018[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]3[/TD]
[TD]Kim[/TD]
[TD]20/01/2018[/TD]
[TD]20/01/2018[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Column C&D shows the gatepass expiry date for respective gates.
User will input the expiry date in B1

Using this sheet i want to generate two sheets showing the matching expiry dates for two gates

Output sheet for Gate 1

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]c[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Sr.No[/TD]
[TD]Emp. Name[/TD]
[TD]Gate1[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]Thomas[/TD]
[TD]20/01/2018[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2[/TD]
[TD]Kim[/TD]
[TD]20/01/2018[/TD]
[/TR]
</tbody>[/TABLE]

Output sheet for Gate 2
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Sr.No[/TD]
[TD]Emp.Name[/TD]
[TD]Gate2[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]Bobby[/TD]
[TD]20/01/2018[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2[/TD]
[TD]Kim[/TD]
[TD]20/01/2018[/TD]
[/TR]
</tbody>[/TABLE]

Please help me with a vb code

Thanks in advance.

CSS

 

[L. Howard]

Try this copied to a standard module. Where you have two sheets named Gate 1 and Gate 2.
Run the code on your Master sheet, where I have your example data items Input Date and 20/01/2018 in cells A1 and B1 with the other data following as you posted.

I get Bobby and Kim Sr.No's as 2 & 3 for Gate 2.

Howard

Sub css0911_Copy()
Dim oneRng As Range, twoRng As Range
Dim c As Range, cc As Range
Dim aDte$

Set oneRng = Sheets("Sheet3").Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row)
Set twoRng = Sheets("Sheet3").Range("D3:D" & Cells(Rows.Count, "D").End(xlUp).Row)

aDte = Sheets("Sheet3").Range("B1")

For Each c In oneRng

    If c = aDte Then
      c.Offset(0, -2).Resize(1, 2).Copy Sheets("Gate 1").Range("A" & Rows.Count).End(xlUp)(2)
      Sheets("Gate 1").Range("C" & Rows.Count).End(xlUp)(2) = aDte
  
    End If

Next

For Each cc In twoRng

    If cc = aDte Then

      cc.Offset(0, -3).Resize(1, 2).Copy Sheets("Gate 2").Range("A" & Rows.Count).End(xlUp)(2)
      Sheets("Gate 2").Range("C" & Rows.Count).End(xlUp)(2) = aDte
  
    End If

Next

End Sub