Alttaki gibi olabilir.Aylerın ve kalemlerim kesiştiği yere ekler.
Tabii Tr karakterlerden dolayı bulamıyor bazılarını.Denemek için kalem kısmına aaa elkedim ve buldu.
Tr karakter olayı için kod düzenlenebilir.

Private Sub CommandButton1_Click() 'Saving Button

    Dim bulAy As Range, bulKalem As Range



    If TextBox2.Value = "" Then

        MsgBox "Gider Fatura Tar.", vbExclamation

        TextBox2.SetFocus

        Exit Sub

    End If

    

    With Sheets("Data")

        Set bulAy = .Range("A:A").Find(Me.ComboBox2.Value, , xlValues, 1)

        Set bulKalem = .Rows(1).Find(Me.ComboBox3.Value, , xlValues, 1)

        If Not bulAy Is Nothing And Not bulKalem Is Nothing Then

            Call Main 'Progress Bar

            .Cells(bulAy.Row, bulKalem.Column) = Me.TextBox4.Value

            

            MsgBox "Registration is successful", vbApplicationModal, ""

            ListBox1.List = .Range("A2:L" & .Cells(Rows.Count, 1).End(xlUp).Row).Value

            TextBox14.Value = ListBox1.ListCount

        Else

            GoTo son

        End If

    End With

son:

    Set bulAy = Nothing

    Set bulKalem = Nothing

End Sub