Excel VBA - how to make this ping test with timer more efficient?

I wrote a small ducktaped vba script which pings servers every 15 mins or so. If a server's status is anything other than "Alive", the server and timestamp is written to another worksheet called "Log".

Sub Countup()
    Dim CountDown As Date
    CountDown = Now + TimeValue("00:00:01")
    Application.OnTime CountDown, "Auto_Open"
End Sub

Sub Auto_Open()

Dim count As Range

Set count = Worksheets("Servers").Range("A1:A1")
count.Value = count.Value - TimeSerial(0, 0, 1)
If count <= 0 Then
    count = Worksheets("Servers").Range("C1:C1")
    Call GetComputerToPing
    Call Countup

    Exit Sub
End If
Call Countup
End Sub

Public Sub addDataToTable(ByVal strTableName As String, ByVal strData As String, ByVal Col As Integer)
    Dim lLastRow As Long
    Dim iHeader As Integer


    With ActiveSheet.ListObjects(strTableName)
        'find the last row of the list
        lLastRow = ActiveSheet.ListObjects(strTableName).ListRows.count
        'shift from an extra row if list has header
        If .Sort.Header = xlYes Then
            iHeader = 1
        Else
            iHeader = 0
        End If
    End With
    'add the data a row after the end of the list
    ActiveSheet.Cells(lLastRow + 1 + iHeader, Col).Value = strData
End Sub


'Requires references to Microsoft Scripting Runtime and Windows Script Host Object Model.
'Set these in Tools - References in VB Editor.


Function sPing(sHost) As String
On Error Resume Next
sHost = Trim(sHost)
Dim ipaddress As String
Dim computername As String
Dim Model As String
Dim memory As Long

Dim oPing As Object, oRetStatus As Object
Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}")
Set oPing = oPing.execquery("select * from win32_pingstatus where address ='" & sHost & "'")
For Each oRetStatus In oPing
    If IsNull(oRetStatus.statuscode) Then
        sPing = "Dead"

    ElseIf oRetStatus.statuscode = 11010 Then
        sPing = "Request Timed Out"
    ElseIf oRetStatus.statuscode = 11013 Then
        sPing = "Destination Host Unreachable"
    Else
        sPing = "Alive"
    End If
Next
Set oPing = Nothing
Set oRetStatus = Nothing
End Function

Sub GetComputerToPing()
Application.DisplayAlerts = False
'On Error Resume Next
Dim applicationobject As Object
Dim i As Integer

i = 3 'row to start checking servers from
Do Until Cells(i, 1) = ""
'If Cells(i, 1) <> "" Then
    'If Cells(i, 2) = "Request Timed Out" Or Cells(i, 2) = "" Or Cells(i, 2) = "Dead" Then
        Cells(i, 2) = sPing(Cells(i, 1))
        Cells(i, 3) = Now()

        'log it to Log
        If Cells(i, 2).Value <> "Alive" Then
            Call copytest(i)
        End If


    'End If
'End If
i = i + 1
Loop
Set applicationobject = Nothing
End Sub


Function findlast_Row() As Long
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Log")

    With ws
        findlast_Row = .Range("A" & .Rows.count).End(xlUp).Row
    End With
End Function
Sub copytest(ByVal intRow As Integer)
'screens for last row in log sheet
iLastRow = findlast_Row() + 1
Worksheets("Log").Range("A" & CStr(iLastRow) & ":E" & CStr(iLastRow)).Value = Worksheets("Servers").Range("A" & CStr(intRow) & ":E" & CStr(intRow)).Value
End Sub

thanks in advance