Loop through recordset - Copy required Field
Sub Copy_Required_Field_from_Recordset()
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim rs As New ADODB.RecordSet
rs.ActiveConnection = cn
'To open Employees Table
rs.Open "Select * from Employees"
Dim Ex As Excel.Application
Set Ex = CreateObject("Excel.Application")
Ex.Visible = True
Dim wkb As Excel.Workbook
Set wkb = Workbooks.Add
wkb.Windows(1).Visible = True
Dim sh As Worksheet
Set sh = wkb.Sheets("Sheet1")
i = 1
Do Until rs.EOF
sh.Cells(i, 3).Value = rs.Fields("Emp_Name")
rs.MoveNext
i = i + 1
Loop
rs.Close
Set rs = Nothing
End Sub