Option Explicit
Sub Copy2Sheet()
Dim lRs As Long: Dim Ff As Byte
Dim Rng As Range, sRng As Range, cRng As Range, Shs As Worksheet
Dim StrC As String, myAdd As String
Sheets("Search").Select: StrC = [c1].Value
Set Rng = Range([A1], [a65500].End(xlUp))
lRs = Rng.Find(What:="Date", LookIn:=xlValues, lookAt:=xlWhole).Row + 1
Application.ScreenUpdating = False: Rows(lRs & ":99").Delete
For Ff = 1 To 2
Set Shs = Sheets(Choose(Ff, "Thu", "Chi"))
Shs.Select
Set Rng = Range([b2], [b2].End(xlDown))
Set sRng = Rng.Find(What:=StrC, LookIn:=xlFormulas)
If Not sRng Is Nothing Then
myAdd = sRng.Address
Do
If cRng Is Nothing Then
Set cRng = sRng.Offset(, -1).Resize(, 5)
Else
Set cRng = Union(cRng, sRng.Offset(, -1).Resize(, 5))
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> myAdd
With Sheets("Search")
cRng.Resize(, 2).Copy Destination:=Choose(Ff, .[a7], .[f7])
cRng.Offset(, 3).Resize(, 2).Copy Destination:=Choose(Ff, .[C7], .[H7])
Set cRng = Nothing
End With
End If
Next Ff
2:
Sheets("Search").Select
lRs = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
With Cells(lRs, "A")
.Offset(, 3).Value = WorksheetFunction.Sum(Range([D7], .Offset(-1, 3)))
.HorizontalAlignment = xlCenter
.Resize(, 3).MergeCells = True: .Value = "Total"
End With
With Cells(lRs, "F")
.Offset(, 3).Value = WorksheetFunction.Sum(Range([I7], .Offset(-1, 3)))
.HorizontalAlignment = xlCenter
.Resize(, 3).MergeCells = True: .Value = "Total"
End With
End Sub