macro for find and copy prilagodba koda

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

Potpis

Jasmin

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.

Potpis

[email protected]=

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

Potpis

Jasmin

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

Potpis

Jasmin

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]