Private Sub Komut22_Click()
On Error Resume Next
If Me.ciftci >= 1 Then
If Me.dur >= 1 Then
Me.say = 6
Call aktar
Else
MsgBox "Lütfen Hayvan Sayısını Giriniz!!! "
End If
Else
MsgBox "Lütfen Önce Aktarmak İstediğiniz Çiftçiyi Seçin!!! "
End If

End Sub
Private Sub aktar()
On Error Resume Next
Dim IE As Object
Set IE = Me.WebBrowser1
 
Dim k As Integer
Dim c As Integer
c = Me.dur + 6
k = Me.say

If k < c Then
Me.hyvkupeno = IE.Document.All.tags("table").Item(3).Rows(k).Cells(1).innerText
Me.hyvdogumtarihi = IE.Document.All.tags("table").Item(3).Rows(k).Cells(2).innerText
Me.irk = IE.Document.All.tags("table").Item(3).Rows(k).Cells(6).innerText
Me.cinsiyet = IE.Document.All.tags("table").Item(3).Rows(k).Cells(3).innerText
If Me.tarih < 6 Then ("tarih"=(bugün-hayvanın doğum tarihi)/30)
Me.yas = "Buzağı"
End If
If Me.tarih >= 6 And Me.tarih <= 12 Then
Me.yas = "Dana"
End If
If Me.tarih > 12 Then
Me.yas = "Sığır"
End If
Me.yas.Requery
Me.hyvhesap = Me.yas.Column(1)
Me.kisiid = Forms![frmsorgula]![kisiid]
Me.personel = Forms![frmsorgula]![personel]
Me.hyvtarih = Date
Me.cins = Me.yas.Column(4)
Me.say = Me.say + 1
Call Komut20_Click
Call tekrar
End If 
           
End Sub

Private Sub tekrar()
Call aktar
End Sub

WebBrowser1.Navigate "https://accesstr.net/sitegenel/isletmedekihayvanlistesi.html"

Private Sub say2()
'On Error Resume Next

    Dim IE As Object
    Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
    Dim HTML_TableRows As Object
    Dim RetVal As Variant, X, A As Integer, SATIRSAYISI As Integer
        
        Set IE = Me.WebBrowser1
        Set HTML_Body = IE.Document.All
        Set HTML_Tables = HTML_Body.tags("Table")
        Set MyTable = HTML_Tables(9)
        
        Set HTML_TableRows = MyTable.GetElementsByTagName("DIV") "HATA BURADA"
        For Each MyRow In HTML_TableRows
            X = X + 1
        Next
        SATIRSAYISI = ((X - 1) / 6) - 3
        Me![sayfa2] = SATIRSAYISI
        
         GoTo SafeExit:
'ErrHandler:
SafeExit:
    Set HTML_Body = Nothing
    Set HTML_Tables = Nothing
    Set MyTable = Nothing
    Set HTML_TableRows = Nothing
    Set HTML_TableDivisions = Nothing
    Set IE = Nothing

End Sub