Minimum hesap işlemi yaparken firma adını da yazsın

[SadiSerdari]

Arkadaşlar aşağıdaki kodlarla minimum fiyatı hesaplatma işlemi yapıyorum. Bununla birlikte, Firma adının da yazılması gerekiyor. Bu noktada yardımcı olabilirseniz sevinirim. Teşekkürler.

Dim iSum As Double
Dim iSums As Double
Dim iMin As Double

Dim iColumns As Long
Dim iRows As Long

Dim rngRows As Range
Dim actSheetRow As Long

Public Function minValue(ByVal mRow As Long, ByVal Stn1 As Integer, ByVal Stn2 As Integer, ByVal Stn3 As Integer)

    actSheetRow = Worksheets(ActiveSheet.Name).UsedRange.Rows.Count - 28
    For iRows = mRow To actSheetRow
    
        Set rngRows = Range(Cells(iRows, Stn1), Cells(iRows, Stn2))
        iMin = Application.WorksheetFunction.Min(rngRows)

        iColumns = iRows
        Cells(iColumns + 20, Stn3) = iMin
        iColumns = iColumns + 1
        
    Next iRows
    
End Function

Sub minValueCol()

    minValue 19, 6, 11, 6

    Call rows_Sum1
    Call rows_Sum2

End Sub

' Sütunların toplama işleminin yapıldığı makro
Dim iRow As Long
Dim iColumn As Long

Sub rows_Sum1()

    For iRow = 19 To 36
        For iColumn = 6 To 11
            iColumns = Range(Cells(19, iColumn), Cells(iRow, iColumn))
            Cells(37, iColumn) = WorksheetFunction.Sum(iColumns)
        Next
    Next

End Sub

Sub rows_Sum2()

    For iRow = 39 To 56
        For iColumn = 6 To 6
            iColumns = Range(Cells(39, iColumn), Cells(iRow, iColumn))
            Cells(57, iColumn) = WorksheetFunction.Sum(iColumns)
        Next
    Next

End Sub

 

[SadiSerdari]

Arkadaşlar; Murat Osma Beyin yardımlarıyla çözülde. Benzer bir durumla karşılaşan arkadaşların işine yarayabileceği düşüncesiyle kodu paylaşmak istedim.

Sub minValueCol()
    Dim Rky As Range
    Dim a As Integer
   
    minValue 19, 6, 11, 6
    Call rows_Sum1
    Call rows_Sum2

    For a = 39 To 56
        If Cells(a, "F") > 0 Then
            Set Rky = Cells.SpecialCells(xlCellTypeConstants).Find(Cells(a, "f"), , , 1)
            If Not Rky Is Nothing Then
                Cells(a, "g") = Cells(16, Rky.Column)
            End If
        End If
    Next a
    a = Empty: Set Rky = Nothing
End Sub