[Excel] Makro koji će kopirati oblast po kriterijumu

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

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

Code:
Private Sub UserForm_Initialize()
Dim oneCell As Range
With Me.ComboBox1
For Each oneCell In ThisWorkbook.Sheets("Imena").Range("A1:A1000")
.AddItem CStr(oneCell.Value)
Next oneCell
End With
End Sub