Extract Data based on Criteria

In your sample there is a Data2 sheet but no Data1 sheet. The Data2 sheet does not show any dates,

@Martin Liss . Very sorry, I want result in Data2

Change row 6 if you want to put the date in a different column.

Sub TransferData()
Dim lngLastRow As Long
Dim lngRow As Long
Dim wsData As Worksheet
Dim wsDest As Worksheet
Const DATE_COL = "C"

Set wsData = ThisWorkbook.Worksheets("Data")
Set wsDest = ThisWorkbook.Worksheets("Data2")

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
wsDest.UsedRange.Cells.Offset(1, 0).ClearContents
With wsData
    lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For lngRow = 2 To lngLastRow
        .Range("A" & lngRow & ":B" & lngRow).Copy wsDest.Range("A" & lngRow + 1)
        Select Case .Range("H" & lngRow)
            Case "Account", "C.O.D."
            .Range("H" & lngRow).Copy wsDest.Range(DATE_COL & lngRow + 1)
        End Select
    Next
End With

wsDest.Activate
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

Select allOpen in new window

In this workbook press Ctrl+Shift+T
29233237.xlsm

The workbook I posted shows this; no P.O's.
If you removed column C then change the two H's in this portion of the code to G's

        Select Case .Range("H" & lngRow)
            Case "Account", "C.O.D."
            .Range("H" & lngRow).Copy wsDest.Range(DATE_COL & lngRow + 1)
        End Select

Select allOpen in new window

If you are still having a problem then please attach your workbook.

@Martin Liss Thanks.  It does not show P.O, but i don't want the data in Data2.  I need to see data where values in column H is Account or C.O.D. While everything else is filterd out.

Please attach your workbook.

This is exactly what I wanted.  Thanks Martin Liss for a an excellent solution.  I really appreciated your help.  Thank you so much for staying with me...

You’re welcome and I’m glad I was able to help. And thank you for the testimonial.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015 and 2017
              Experts Exchange Distinguished Expert in Excel 2018 and 2021
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2020
              Experts Exchange Top Expert VBA 2018 to 2020