kod satırlarını kontrol ettim aynısı. zaten dediğim gibi sizin gönderdiğiniz dosya üzerinde bir oynama yapmadan ekran görüntüsü aldım

"Puantaj2Hesap" fonksiyonuna 1 satır eklenip hemen altındaki 10 öğretmen kontrol döngüsü değiştirildi
aşağıdaki 2 satır değiştirilen satırlar.
dilerim düzelmiştir

satirKont = WorksheetFunction.CountA(Sheets("Puantaj2").Range("A" & yPntj & ":c" & yPntj))  '<== Eklenen Satır

        If yPntj > 12 And satirKont = 1 Then  '<== Düzenlenen Satır  "And satirKont = 1" eklendi

aşağıdaki kod da fonksiyonun tamamı

Sub Puantaj2Hesap()

Dim EkASon, EkFSon, EkSonStn, X0, X1, yPntj, zSon As Long

Dim satirKont As Integer

On Error Resume Next

Tbas = Now

EkASon = Cells(Rows.Count, 1).End(xlUp).Row '

EkFSon = Cells(Rows.Count, 6).End(xlUp).Row

EkSonStn = Cells(3, Columns.Count).End(xlToLeft).Column





X0 = 3

X1 = 3

yPntj = 3

    Do While X1 <= EkFSon

satirKont = WorksheetFunction.CountA(Sheets("Puantaj2").Range("A" & yPntj & ":c" & yPntj))  '<== Eklenen Satır

        If yPntj > 12 And satirKont = 1 Then  '<== Düzenlenen Satır  "And satirKont = 1" eklendi

        Sheets("Puantaj2").Rows(yPntj).Insert Shift:=xlShiftDown, CopyOrigin:=0

        End If



        Sheets("Puantaj2").Range("A" & yPntj) = Range("A" & X0)

        Sheets("Puantaj2").Range("B" & yPntj) = Range("D" & X0)

        Sheets("Puantaj2").Range("C" & yPntj) = Range("E" & X0)

        X1 = Range("A" & X0).End(xlDown).Row

        If X1 > EkFSon Then X1 = EkFSon + 1

        For x = X0 To X1 - 1

            stn = vCevir2(Range("h" & x).Value)

            Sheets("Puantaj2").Range(stn & yPntj).Value = Cells(x, EkSonStn).Value

        Next

    yPntj = yPntj + 1

    X0 = X1



    Loop

'Formul___________________

zSon = Sheets("Puantaj2").Cells(Rows.Count, 13).End(xlUp).Row '13 ==> M sütunu

Sheets("Puantaj2").Range("M3") = "=sum(D3:L3)"

Sheets("Puantaj2").Range("M3:M" & zSon).FillDown

Sheets("Puantaj2").Range("D" & zSon) = "=sum(D3" & zSon - 1 & ")"

Sheets("Puantaj2").Range("D" & zSon & ":L" & zSon).FillRight

'___________________bitti

'Çerçeve__________________________

Range("A12:L" & zSon - 1).Borders.LineStyle = xlContinuous

'___________________Bitti



Tbit = Now

Sure = DateDiff("s", Tbas, Tbit) 'Tbit - Tbas

tSny = Sure Mod 60

tDk = Sure \ 60

MsgBox ("İşlem " & tDk & " dakika :" & tSny & " saniyede bitti") ' Tbit & " - " & Tbas)

End Sub

Sayın Haliliyas 
Gayet iyi oldu. çok düzgün çalışıyor. Çok teşekkür ediyorum. 
Emeğinize sağlık

şu an sorunsuz çalışıyor mu?

Evet O sayfa sorunsuz çalışıyor çok teşekkür ediyorum

ÖD
iyi çalışmalar