Sub Macro1()

    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim SQL$, arr, i&, j&, lr&, lc%, s$, t$
    
       arr = [a1].CurrentRegion
    
        lr = UBound(arr)
        lc = UBound(arr, 2)
       Dim nom As String
    nom = Worksheets("Feuil1").Range("A1")
    
        Dim col As Integer
    Select Case nom
     Case "NN"
     col = 3
     Case "MM"
     col = 8
    End Select
    
       t = "[Write$" & Range("a" & col).Resize(2, lc).Address(0, 0) & "]"
        
       cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\write.xlsx"
    
       For i = 2 To lr
    
                SQL = "select * from " & t & " where f2='" & arr(i, 2) & " '"
               Set rs = New ADODB.Recordset
        
               rs.Open SQL, cnn, 1, 3
        
               If rs.RecordCount Then
        
                      s = ""
            
                       For j = 3 To lc
                s = s & "f" & j & "=" & arr(i, j) & " ,"
            Next
            
                       SQL = "update " & t & " set " & Left(s, Len(s) - 1) & "  where f2='" & arr(i, 2) & " '"
                        cnn.Execute SQL
            
        End If
    Next
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    
End Sub