Copy in a new sheeet, rows that have a certain date in them

[daniels012]

Using code:
How can I copy rows that have specific dates from a sheet named "Total" to the current sheet I am in?

Rather than manually copying and pasting, it would be much easier if I could do it using code.

Any Ideas?

Michael

 

[daniels012]

Anyone?
Michael

 

[daniels012]

After all of that here is what was done by "Gibbs"

Sub CreateNewMOnth2()
Application.ScreenUpdating = False
Dim ShName As String, ShExists As Boolean
Dim c As Range, ws As Worksheet, wks1 As Worksheet, wks2 As Worksheet
Dim rngtoSearch As Range, rngDestination As Range, rngFound As Range
Dim MyDate As String, rngFirst As Range, rngAllrecords As Range
ShName = ActiveSheet.Range("E1").Text
MyDate = Left(Range("F2"), 2) - 1 & Right(Range("F2"), 4)
On Error Resume Next
ShExists = Len(Worksheets(ShName).Name) > 0
    On Error GoTo 0
    If ShExists Then
    MsgBox "Worksheet already exists", 48, "Title"
    Else
    ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = ShName
    End If

'will return 11 2005
MsgBox MyDate
Set wks1 = Sheets("running total")
Set wks2 = Sheets(ShName)
Sheets("Running Total").Range("A6").EntireRow.Copy
wks2.Range("A5").PasteSpecial
Application.CutCopyMode = False
wks2.Cells(3, 1) = ShName
Set rngtoSearch = wks1.Columns("BN") 'column BN has a formula in it to return the month year of date in column K in 'mmyyyy'
Set rngDestination = wks2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
   Set rngFound = rngtoSearch.Find _
   (What:=MyDate, LookIn:=xlValues, LookAt:=xlWhole)
            If Not rngFound Is Nothing Then
             On Error Resume Next
             lngNextRow = 1
             Set rngFirst = rngFound
             Set rngAllrecords = rngFound
               Do
                Set rngAllrecords = Union(rngAllrecords, rngFound)
                Set rngFound = rngtoSearch.FindNext(rngFound)
                Loop Until rngFound.Address = rngFirst.Address
                
                rngAllrecords.EntireRow.Copy rngDestination.EntireRow
                
            End If
            Columns("A:O").Select
    Columns("A:O").EntireColumn.AutoFit
    Range("A3").Select
    Selection.NumberFormat = "mmmm yyyy"
    Range("A3:B3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

Thank You so much ray:
Michael