[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]
[color=darkblue]Sub[/color] test()
[color=darkblue]Dim[/color] wkbSource [color=darkblue]As[/color] Workbook
[color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
[color=darkblue]Dim[/color] wkbDest [color=darkblue]As[/color] Workbook
[color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
[color=darkblue]Dim[/color] FoundCells [color=darkblue]As[/color] Range
[color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
[color=darkblue]Dim[/color] FirstAddress [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Set[/color] wkbSource = Workbooks("file-1.xlsx")
[color=darkblue]Set[/color] wksSource = wkbSource.Worksheets("Sheet1")
[color=darkblue]Set[/color] wkbDest = Workbooks("file-2.xlsx")
[color=darkblue]Set[/color] wksDest = wkbDest.Worksheets("Sheet2")
[color=darkblue]With[/color] wksSource.Columns("E")
[color=darkblue]Set[/color] Cell = .Find(what:=Date, LookIn:=xlFormulas)
[color=darkblue]If[/color] [color=darkblue]Not[/color] Cell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
FirstAddress = Cell.Address
[color=darkblue]Do[/color]
Cnt = Cnt + 1
[color=darkblue]If[/color] FoundCells [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
[color=darkblue]Set[/color] FoundCells = Cell.EntireRow
[color=darkblue]Else[/color]
[color=darkblue]Set[/color] FoundCells = Union(FoundCells, Cell.EntireRow)
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]Set[/color] Cell = .FindNext(Cell)
[color=darkblue]Loop[/color] [color=darkblue]While[/color] Cell.Address <> FirstAddress
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]If[/color] Cnt > 0 [color=darkblue]Then[/color]
[color=darkblue]With[/color] wksDest
[color=darkblue]With[/color] .UsedRange
NextRow = .Rows.Count + .Rows(1).Row
[color=darkblue]End[/color] [color=darkblue]With[/color]
FoundCells.Copy .Cells(NextRow, "A")
MsgBox "Completed...", vbInformation
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]Else[/color]
MsgBox "No records found...", vbInformation
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]