Soru Kodu kısaltmak istiyorum

[selus]

Merhabalar aşağıda yazdığım vba kodunu tek tek yazmak yerine daha kısa nasıl yapabilirim? Ek olarak ters durumlarını da ele almak istiyorum ama nasıl yapacağımı bulamadım. Yardımcı olursanız teşekkür ederim. cells(1,4) ve cells(1,6) diye belirttiğim yerler aslında veri doğrulama listesidir.

Sub deneme()
Dim i As Integer

'sonsatir son satıra yeni veri girişi için
sonsatir = Cells(Rows.Count, "B").End(xlUp).Row

For i = 4 To sonsatir
    If Cells(1, 4) = "A FİRMA" And Cells(1, 6) = "A FİRMA" Then
    Cells(i, 9) = Cells(i, 4) / Cells(i, 4)
    
    ElseIf Cells(1, 4) = "A FİRMA" And Cells(1, 6) = "B FİRMA" Then
    Cells(i, 9) = Cells(i, 4) / Cells(i, 5)
    
    ElseIf Cells(1, 4) = "A FİRMA" And Cells(1, 6) = "C FİRMA" Then
    Cells(i, 9) = Cells(i, 4) / Cells(i, 6)
    
    ElseIf Cells(1, 4) = "A FİRMA" And Cells(1, 6) = "D FİRMA" Then
    Cells(i, 9) = Cells(i, 4) / Cells(i, 7)
    
    ElseIf Cells(1, 4) = "A FİRMA" And Cells(1, 6) = "Toplam %" Then
    Cells(i, 9) = Cells(i, 4) / Cells(i, 8)
    
    ElseIf Cells(1, 4) = "B FİRMA" And Cells(1, 6) = "B FİRMA" Then
    Cells(i, 9) = Cells(i, 5) / Cells(i, 5)
    
    ElseIf Cells(1, 4) = "B FİRMA" And Cells(1, 6) = "C FİRMA" Then
    Cells(i, 9) = Cells(i, 5) / Cells(i, 6)
    
    ElseIf Cells(1, 4) = "B FİRMA" And Cells(1, 6) = "D FİRMA" Then
    Cells(i, 9) = Cells(i, 5) / Cells(i, 7)
    
    ElseIf Cells(1, 4) = "B FİRMA" And Cells(1, 6) = "Toplam %" Then
    Cells(i, 9) = Cells(i, 5) / Cells(i, 8)
    
    ElseIf Cells(1, 4) = "C FİRMA" And Cells(1, 6) = "C FİRMA" Then
    Cells(i, 9) = Cells(i, 6) / Cells(i, 6)
    
    ElseIf Cells(1, 4) = "C FİRMA" And Cells(1, 6) = "D FİRMA" Then
    Cells(i, 9) = Cells(i, 6) / Cells(i, 7)
    
    ElseIf Cells(1, 4) = "C FİRMA" And Cells(1, 6) = "Toplam %" Then
    Cells(i, 9) = Cells(i, 6) / Cells(i, 8)
    
    ElseIf Cells(1, 4) = "D FİRMA" And Cells(1, 6) = "D FİRMA" Then
    Cells(i, 9) = Cells(i, 7) / Cells(i, 7)
    
    ElseIf Cells(1, 4) = "D FİRMA" And Cells(1, 6) = "Toplam %" Then
    Cells(i, 9) = Cells(i, 7) / Cells(i, 8)
    
    ElseIf Cells(1, 4) = "Toplam %" And Cells(1, 6) = "Toplam %" Then
    Cells(i, 9) = Cells(i, 8) / Cells(i, 8)
    
    
    End If

Next i

End Sub