sorgulamayı yapıyor ama excel sayfasına yazdıramadım

[ayder12]

ekde dosyayı koydum
düzeltebilecek biri olursa sevinirim

 

[Kemal Demir]

Private Sub CommandButton1_Click()
On Error Resume Next
Dim IE As Object
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Dim RetVal As Variant
If TextBox1.Value = "" Or TextBox2.Value = "" Or TextBox3.Value = "" Or TextBox4.Value = "" Then
MsgBox ("Boş alan Bıraktınız")
Exit Sub
End If
ilk = TextBox3
son = TextBox4
For z = ilk To son
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
ADI = TextBox1
SADI = TextBox2
DoEvents
Label5 = "D.Yılı" & " " & ":" & z
alan = "http://www.emekli.gov.tr/bilgi/SicilTespitiServlet2?ad2=" & ADI & " &soyad=" & SADI & "&dogumYil=" & z & "&mevzuatgoruntuleButon=TAMAM"
URL = alan
DoEvents
WebBrowser1.Navigate2 (alan) 'CreateObject("InternetExplorer.Application")
  With WebBrowser1
        .Navigate URL
        .Visible = True
     Do Until WebBrowser1.ReadyState = 4: DoEvents: Loop
        With .Document.all
        End With
        Set HTML_Body = WebBrowser1.Document.getElementsByTagName("Body").Item(0)
        Set HTML_Tables = HTML_Body.getElementsByTagName("Table")
           Set MyTable = HTML_Tables(2)
    For x = 0 To 20
    son = [a65536].End(3).Row + 1
    Cells(son, 1) = MyTable.Rows(x).Cells(0).innerText
    Cells(son, 2) = MyTable.Rows(x).Cells(1).innerText
    Cells(son, 3) = MyTable.Rows(x).Cells(2).innerText
    Cells(son, 4) = MyTable.Rows(x).Cells(3).innerText
    Cells(son, 5) = MyTable.Rows(x).Cells(4).innerText
    Cells(son, 6) = MyTable.Rows(x).Cells(5).innerText
    Cells(son, 7) = MyTable.Rows(x).Cells(6).innerText
    Cells(son, 8) = MyTable.Rows(x).Cells(7).innerText
  '  Cells(son, 9) = MyTable.Rows(x).Cells(8).innerText
    Cells(son, 10) = "'" & y & "-" & x
 Next
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
   End With
Next
   Set HTML_Body = Nothing
    Set HTML_Tables = Nothing
    Set MyTable = Nothing
    Set IE = Nothing
End Sub

Yukarıdaki gibi değiştiriniz.

 

[ayder12]

teşekkür ederim eline sağlık