Sub GetAccessData()Application.ScreenUpdating = False

Dim RS As ADODB.Recordset
Dim CON As ADODB.Connection
Dim arr, i%
       
Set RS = New ADODB.Recordset
Set CON = New ADODB.Connection
CON.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\Access\test.accdb"
Set RS.ActiveConnection = CON
RS.CursorLocation = adUseClient
    
    'Очистка
    Cells.ClearContents
    
    'Основная часть
    RS.Open "SELECT ColorName, Color FROM tbl_test"
    arr = RS.GetRows(RS.RecordCount)
    [A1].Resize(UBound(arr, 2) + 1, 1) = Application.WorksheetFunction.Transpose(arr)
    '?????
    
RS.Close: CON.Close
Set RS = Nothing: Set CON = Nothing

Application.ScreenUpdating = True
End Sub

Sub test()
Dim i%, x#

[B:B].ClearContents

For i = 1 To 10

    On Error GoTo errH1
        If Cells(i, 1).Value > 3 Then
            On Error GoTo errH2
            x = 1 / 0
        End If
    
'Если ошибка в условии цикла, значит Netx
errH2:
If Err.Number > 0 Then
    Cells(i, 2).Value = "Ошибка 2"
    Err.Clear
End If

Next

'Если ошибка перед условием цикла, значит End
errH1:
If Err.Number > 0 Then
    Cells(i, 2).Value = "Ошибка 1"
End If


End Sub