IF condition meets import line to another file

[khalidnisar]

Hi, I need help,i am trying to import a line from another excel file say "file-1.xlsx , sheet1", when a particular conditions meets in a column 'E' say when cell=today's date then import then full line to another file called "file-2.xlsx, sheet-2 in first empty line".Also the date from hidden lines i don't want them to be extracted.
any help will be highly appreciated.thanking in advance.
regards Khalid

 

[Domenic]

Assuming that both workbooks are open, try...

[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]

 

[khalidnisar]

Works perfect. Thx a million time Domenic. You are a life saver.
regards.
Khalid

 

[Domenic]

You're very welcome! And thanks for the feedback!