Dim Web As Object
Sub SorgulaB()
Dim Son As Integer, Say As Integer
Son = ActiveSheet.Range("A65536").End(xlUp).Row
Set Web = CreateObject("InternetExplorer.application")
Web.Navigate "http://www.ailehekimibul.com"
For Say = 2 To Son
Denetle ActiveSheet.Range("A" & Say).Value, Say
Next
Set Web = Nothing
MsgBox "İşlem tamam.", vbInformation, "Sonuç"
End Sub

Sub Denetle(TC, Say)
On Error GoTo Hata
Web.Navigate "http://www.ailehekimibul.com"
Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop
Web.Document.getElementById("tc").Value = TC
Web.Document.getElementById("Sorgula").Click

Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop

With ActiveSheet
.Range("B" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(1).Cells(1).innerText
.Range("C" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(2).Cells(1).innerText
.Range("D" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(3).Cells(1).innerText
.Range("E" & Say).Value = Web.Document.all.tags("table").Item(6).Rows(4).Cells(1).innerText
End With
Exit Sub
Hata:
Range("A1") = Err.Number
If Err.Number = 91 Then
Err.Clear
Do While Web.Busy: DoEvents: Loop
Do While Web.ReadyState <> 4: DoEvents: Loop
If InStr(Web.Document.all.tags("table").Item(2).innerText, "SORGULADIĞINIZ KİŞİNİN") > 0 Then Exit Sub
Resume
Else: Exit Sub
End If
End Sub