Macro to Filter Copy the rows based on input

[souvick]

Hi,

I am looking for help in writing a macro to filter copy the rows in excel and create new sheets. I have attached a template file for help.

The excel can have data for n number of rows and from Column A:CF

In cell B1, reporting month will be given as input in MM/DD/YYYY format. Once the data is input in cell B1, macro should match that data for every row in Column D and once Match found, it should create a new worksheet with Month name and paste all the rows for that month in the new sheet.

Thanks in advance for help

Regards
Paul

[venkat1926]

Sub test()
Dim ddate As Date, rdata As Range, filt As Range, mmonth As String
Worksheets("sheet1").Activate
ddate = Range("B1").Value
mmonth = WorksheetFunction.Text(ddate, "mmm")
'MsgBox mmonth
Set rdata = Range("a3").CurrentRegion
'MsgBox rdata.Address
rdata.AutoFilter Field:=4, Criteria1:=">=" & ddate, Operator:=xlAnd, Criteria2:="<" & ddate + 1
Set filt = rdata.Offset(1, 0).Resize(rdata.Rows.Count - 1, rdata.Columns.Count).SpecialCells(xlCellTypeVisible)
filt.Copy
 If Not SheetExists(mmonth) Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = mmonth
End If
With ActiveSheet
.Range("a1").PasteSpecial
End With
Worksheets("sheet1").Activate
ActiveSheet.AutoFilterMode = False
Application.CutCopyMode = False
End Sub

Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(Sheets(SheetName).Name) > 0 Then
        SheetExists = True
        Exit Function
    End If
NoSuchSheet:
End Function

[souvick]

Thanks Venkat,

This works fine but I have two issues here:
1. It doesn't copy the header row to the new sheet that I need
2. On repeat run with same input month, ideally it should delete that month's exisitng sheet and recreate the output.Currently it is not able to handle that.

Can you suggest something on this?

Thanks and Regards
Paul