Option Explicit

Private Sub CommandButton1_Click()

Dim clngvbNullString As Long
Dim avntJersey As Variant
Dim avntStanding  As Variant
Dim avntStage  As Variant
Dim iavntJersey As Long
Dim iavntStanding As Long
Dim iavntStage As Long
Dim lngCol As Long
Dim lngRow  As Long
Dim objHTML1 As Object
Dim objHTML2 As Object
Dim objIE As Object
Dim objWorksheet As Object
Dim strStage As String

With Application
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

avntStanding = Array("G", "Algemeen", "E", "Etappe") 'id's in html-broncode en tab-namen
avntJersey = Array("IT", "Individueel", "IP", "Punten", "ET", "Ploegen", "IM", "Berg", "IJ", "Jongeren") 'id's in html-broncode en tab-namen

For Each objWorksheet In Worksheets 'wis alle bladen behalve "Invoer"
    If objWorksheet.Name <> "Invoer" Then
        objWorksheet.Delete
    End If
Next

Set objIE = CreateObject("InternetExplorer.Application") 'maak verbinding met internet explorer
objIE.Navigate "http://www.letour.fr/" & CStr(Range("C2").Value) & "/TDF/LIVE/us/" & CStr(100 * Range("C3").Value) & "/classement/index.html" 'maak verbinding met website
objIE.Visible = True 'maak internet explorer zichtbaar
Do While objIE.Busy Or objIE.readyState <> 4 'wacht tot internet explorer klaar is
    DoEvents
Loop

Set objHTML1 = objIE.document 'lees document
For iavntStanding = 0 To UBound(avntStanding) Step 2 'doorloop rangschikkingen
    objHTML1.getElementbyid(avntStanding(iavntStanding)).Click 'klik rangschikking
    Application.Wait (Now + TimeValue("0:00:0" & Range("C4").Value)) 'wacht
    Set objHTML2 = objHTML1.getElementbyid("detailDiv").document 'lees document
    For iavntJersey = 0 To UBound(avntJersey) Step 2 'doorloop trui
        objHTML2.getElementbyid(avntJersey(iavntJersey)).Click 'klik trui
        Application.Wait (Now + TimeValue("0:00:0" & Range("C4").Value)) 'wacht
        Do
            strStage = objHTML1.getElementbyid("contentDetailDyn").innertext 'lees text in html-broncode
        Loop Until strStage <> vbNullString And strStage <> "Loading..." 'niet leeg en niet "Loading"
        avntStage = Split(strStage, vbCrLf) 'opdelen
        With Worksheets.Add(, Worksheets(Worksheets.Count)) 'voeg tabblad toe
            .Name = avntStanding(iavntStanding + 1) & "_" & avntJersey(iavntJersey + 1) 'stel naam van tabblad in
            lngRow = 1 'rij am_2011
            lngCol = 0 'kolom
            clngvbNullString = 0 'aantal lege regels na elkaar
            For iavntStage = 0 To UBound(avntStage) 'doorloop text
                Select Case avntStage(iavntStage)
                    Case Is = "<div class='errormess'><activez_javascript:></div>" 'einde (sub)tabel
                        lngRow = lngRow + 1 'volgende rij
                        lngCol = 0 'kolom
                    Case Is <> vbNullString
                        lngCol = lngCol + 1 'volgende kolom
                        .Cells(lngRow, lngCol).Value = avntStage(iavntStage) 'schrijf data
                        clngvbNullString = 0 'aantal lege regels na elkaar
                    Case Is = vbNullString
                        clngvbNullString = clngvbNullString + 1 'aantal lege regels na elkaar
                End Select
                If clngvbNullString = 3 Then 'wanneer het aantal lege regels na elkaar 3 is, is de rij kompleet
                    lngRow = lngRow + 1 'volgende rij
                    lngCol = 0 'kolom
                    clngvbNullString = 0 'aantal lege regels na elkaar
                End If
            Next
            .Rows(1).Delete 'verwijder eerste rij (individual points team climber youth)
            .Columns("A:F").AutoFit 'automatisch kolombreedte
        End With
    Next
Next

objIE.Quit

Set objWorksheet = Nothing
Set objHTML2 = Nothing
Set objHTML1 = Nothing
Set objIE = Nothing

With Application
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub