macro for find and copy prilagodba koda

[ jaskojsako @ 06.08.2014. 20:21 ] @

Poz
ovaj kod mi odrađuje super kada unesem jedan datum za pretragu e sad bi mi trebalo
preurediti kod da mi odrađuje pretragu i kopiranje između dva datuma
ako ima voljni unaprijed hvala

Application.ScreenUpdating = False
Dim rangeToSearch As Range
Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row)

Dim searchAmount As Date
searchAmount = InputBox("Type in the amount to search for:")

Dim cell As Date
For Each cell In rangeToSearch
If cell = CLng(searchAmount) Then
Sheets(1).Rows(cell.Row & ":" & cell.Row).Copy
Sheets(2).Rows( _
Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 & _
":" & _
Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 _
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
Application.ScreenUpdating = True

_{[Ovu poruku je menjao jaskojsako dana 06.08.2014. u 23:11 GMT+1]}

[ FOX028 @ 07.08.2014. 06:58 ] @

Prepravio sam ovaj tvoj kod, u komentarima sam ti napisao sta sam dodao a sta izmenio. Ovo bi trebalo da radi, ja nisam imao primer u kom bih mogao isprobati ali ti isprobaj u tvom primeru da li radi.

Code:
Application.ScreenUpdating = False
Dim rangeToSearch As Range
Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row)

Dim searchAmount1 As Date
Dim searchAmount2 As Date   'dodato
searchAmount1 = InputBox("Type in the amount 1 to search for:")
searchAmount2 = InputBox("Type in the amount 2 to search for:") 'dodato

Dim cell As Date
For Each cell In rangeToSearch
    If cell >= CLng(searchAmount1) And cell <= CLng(searchAmount2) Then 'izmenjeno
        Sheets(1).Rows(cell.Row & ":" & cell.Row).Copy
        Sheets(2).Rows( _
        Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 & _
        ":" & _
        Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 _
        ).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next
Application.ScreenUpdating = True

[ jaskojsako @ 07.08.2014. 08:48 ] @

poz
hvala na odgovoru,ali prijavljuje grešku na ovoj liniji koda
For Each cell In rangeToSearch ( označi cell) a greška koju prijavljuje
for each control variable must be variant or object
a uopšte ne polazuje input box za unos datuma
poz

[ jaskojsako @ 07.08.2014. 13:56 ] @

Riješeno
Hvala članu FOX028 tvoj kod radi treba samo dodati rcell

[ FOX028 @ 07.08.2014. 15:55 ] @

Evo malo uprošćenog koda
[code]Application.ScreenUpdating = False
Dim rangeToSearch As Range
Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row)

Dim searchAmount1 As Date
Dim searchAmount2 As Date 'dodato
searchAmount1 = InputBox("Type in the amount 1 to search for:")
searchAmount2 = InputBox("Type in the amount 2 to search for:") 'dodato

Dim cell As Range
Dim i As Integer
Dim Uslov As Boolean
i = 2
For Each cell In rangeToSearch
Uslov = cell.Value >= CLng(searchAmount1) And cell.Value <= CLng(searchAmount2)
If Uslov Then 'izmenjeno
Sheets(1).Rows(cell.Row).Copy
Sheets(2).Range("A" & i).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, False, False
Application.CutCopyMode = False
i = i + 1
End If
Next

Application.ScreenUpdating = True
[\code]

[ jaskojsako @ 04.07.2016. 22:41 ] @

Moze li ovom kodu da osim datuma od-do što je OK
da se doda treci uslov i četvrti uslov za pretragu

Sada pretražuje Range ("C" )za datum i to je OK
a kako dodati treci uslov da vrši pretragu u Range (" D") ----( traži šifru 2 )
i četvrti uslov pretragu u Range (" F") -----( traži šifru broj 3)

_{[Ovu poruku je menjao jaskojsako dana 04.07.2016. u 23:58 GMT+1]}