Copy Paste cells to next sheeet

Dear Colleagues please help me I am working to manage vba code but fail. My code work well but one issue involved that data has been pasted on Sheet 2 . I need data on sheet 2 date wise as shown in the image.


Sub CopyRows()
Dim lRow As Integer


lRow = Sheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Row

For Each cell In Sheets("sheet1").Range("F9:F" & lRow)
If Cells(cell.Row, "F").Value = "Cash" Then

Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Sheets("Sheet1").Range("D" & cell.Row).Value
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Sheets("Sheet1").Range("F" & cell.Row).Value
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Sheets("Sheet1").Range("H" & cell.Row).Offset(2, 0).Value

End If
Next cell


For Each cell In Sheets("sheet1").Range("G9:G" & lRow)
If Cells(cell.Row, "G").Value = "Cash" Then
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Sheets("Sheet1").Range("D" & cell.Row).Offset(-1, 0).Value
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Sheets("Sheet1").Range("G" & cell.Row).Value

Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Sheets("Sheet1").Range("H" & cell.Row).Offset(1, 0).Value

End If


Next cell

End sub