VBA Macro to copy cells to another sheet based on the date value

Hi ,
newbie in macro

in sheet1 are three columns

1 ____ A _______ B ___ C
2 __ 30/03/12 __ a __ 51
3 __ 30/03/12 __ b __ 52
4 __ 31/03/12 __ c __ 53
5 __ 31/03/12 __ d __ 54
6 __ 01/04/12 __ e __ 55
7 __ 01/04/12 __ f __ 56
8 __ 01/04/12 __ g __ 57
9 __ 02/04/12 __ h __ 58

if in sheet2 and the cell H1 = 31/03/12

i wont to copy in A1 :C2 the cells of sheet2 A4:C5

like

1 _____ A _____ B __ C ________ 31/03/12
2 __ 31/03/12 __ c __ 53
3 __ 31/03/12 __ d __ 54

Or H1 = 01/04/12
then copy A6:C8

Hello and welcome to the forum.

See if this does as you need.

Sheet references are Sheet Code Names. Adjust the names as needed.

Option Explicit

Sub Copy_By_Date_Criteria()

    Dim nextrow As Long, bottomrow As Long
    Dim rngFilter As Range
    Dim sCriteria As String
    
    Application.ScreenUpdating = False
    
    With Sheet2 '//sheet code name
        nextrow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        sCriteria = .Range("H1").Value
        
        If Not IsDate(sCriteria) Then
            MsgBox ("Invalid date criteria"), vbExclamation
            Exit Sub
        End If
        
    End With
    
    With Sheet1 '//sheet code name
        .AutoFilterMode = False
        bottomrow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rngFilter = .Range("A1:C" & bottomrow)
        rngFilter.AutoFilter field:=1, Criteria1:=sCriteria
        rngFilter.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A" & nextrow)
        .AutoFilterMode = False
    End With
    
    Set rngFilter = Nothing
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Content deleted