Jedan (ne najoptimalniji) način je da ideš red po red u opsegu I14:N493, ispituješ da li je zadovoljen uslov i ako jeste kopiraš počevši od A14 nadole.
Kode sam razdvojio na proceduru koja kopira (da bude malo univerzalnije) i kod koji poziva ovu proceduru u tvom konkretnom slučaju
Code:
Sub MyCopy(srcRng As Range, dstRng As Range, Kriterijum As Double)
' Kopira iz zadatog opseca srcRng u odredišni opseg
' sve redove do reda u kojem je ispunjen kriterijum u poslednjoj koloni
' P. Jovanovic za elitesecurity.org
Dim r As Long
Dim rt As Long, ct As Long
Dim sht As Worksheet
Dim cl As Integer, lastcol As Integer
r = 1
rt = dstRng.Row
ct = dstRng.Column
Set sht = dstRng.Worksheet
lastcol = srcRng.Columns.Count
Do While srcRng.Cells(1, lastcol).Offset(rowOffset:=r - 1) >= Kriterijum
For cl = 1 To lastcol ' prenosi vrednosti iz reda
sht.Cells(rt, ct + cl - 1).Value = srcRng.Cells(r, cl).Value
Next cl
r = r + 1
rt = rt + 1
Loop
End Sub
Poziv prethodne procedure
Code:
Sub Test()
Dim sh As Worksheet
Set sh = ActiveSheet
Application.ScreenUpdating = False
MyCopy sh.Range("I14:N493"), sh.Range("A14"), -0.01
Application.ScreenUpdating = True
' Prepis teksta iz M2
sh.Range("A14").End(xlDown).Offset(rowOffset:=1).Value = sh.Range("M2").Text
End Sub
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
[Excel] Makro koji će kopirati oblast po kriterijumu
