Option Explicit Sub IlkUcRapor() Dim ws As Worksheet, i As Long, j As Long, sira As Long Dim tutar As Variant Set ws = ThisWorkbook.Worksheets("Ornek") ws.Range("E14:G16").ClearContents ws.Range("F8").ClearContents For i = 5 To 10 tutar = ws.Cells(i, 2).Value2 If IsError(tutar) Then ws.Range("F8").Value = "Ciro hatali" Exit Sub End If If Len(CStr(tutar)) = 0 Or Not IsNumeric(tutar) Then ws.Range("F8").Value = "Sayisal ciro girin" Exit Sub End If Next i ws.Range("E13").Value = "Sira" ws.Range("F13").Value = "Satici" ws.Range("G13").Value = "Ciro" For i = 5 To 10 sira = 1 For j = 5 To 10 If CDbl(ws.Cells(j, 2).Value2) > CDbl(ws.Cells(i, 2).Value2) Or _ (CDbl(ws.Cells(j, 2).Value2) = CDbl(ws.Cells(i, 2).Value2) And j < i) Then sira = sira + 1 End If Next j If sira <= 3 Then ws.Cells(13 + sira, 5).Value = sira ws.Cells(13 + sira, 6).Value = ws.Cells(i, 1).Value ws.Cells(13 + sira, 7).Value = ws.Cells(i, 2).Value End If Next i ws.Range("F8").Value = "Rapor hazir" End Sub