Sub kopeerimine1()
  Dim cn As New ADODB.Connection
  Dim rs As ADODB.Recordset
  Dim lause As String
  cn.Open "yhendus1"
  lause = "SELECT eesnimi, perekonnanimi, mid(eesnimi, 1, 1) FROM inimesed "
& _
             "ORDER BY eesnimi DESC"
  Set rs = cn.Execute(lause)
  Cells.Clear
  reanr = 1
  Do While Not rs.EOF
    'MsgBox rs("eesnimi")
    Cells(reanr, 1) = rs("eesnimi")
    Cells(reanr, 2) = rs("perekonnanimi")
    Cells(reanr, 3) = rs(2)
    rs.MoveNext
    reanr = reanr + 1
  Loop
  cn.Close
End Sub