Dim WithEvents q As QueryTable

Private Sub q_AfterRefresh(ByVal Success As Boolean)
'  Debug.Print "AfterRefresh", Now
  With Sheet2
    LastRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
    If LastRow < 5 Then LastRow = 4
     If Sheet1.Range("A101") <> .Cells(LastRow, 1) Then
      arr = Sheet1.Range("A101:U101")
      For i = 2 To UBound(arr, 2)
          If (arr(1, i) Mod 2) - 1 Then
            arr(1, i) = "Чёт"
          Else
            arr(1, i) = "Нечёт"
          End If
      Next
      .Cells(LastRow + 1, 1).Resize(, UBound(arr, 2)) = arr
     End If

  End With
End Sub

'Private Sub q_BeforeRefresh(Cancel As Boolean)
'  Debug.Print "BeforeRefresh", Now
'End Sub

Private Sub Workbook_Open()
 ' Application.OnTime Now, Me.Name & ".Start"
Set q = Sheet1.QueryTables(1)
End Sub

'Sub Start()
'  Set q = Sheet1.QueryTables(1)
'End Sub