Transfering data between Sheets

Sub one_way()
  'For prior to Excel 2007  (modify strConn for Excel 2007)
 
  'Assumes file has been saved at sometime, field headers
  'in first row with data under. Assumed header names are
  '"Company Name", "Contracted" and "Previous Exhibitor"
 
  Const strWksOneName As String = "one worksheet"
  Const strWksOtherName As String = "another worksheet"
 
  Dim strConn As String
  Dim strSQL As String
  Dim objConnection As Object
  Dim objRS As Object
 
  strConn = Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
      ActiveWorkbook.FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)
 
  strSQL = Join$(Array( _
      "SELECT A.`Company Name`", _
      "FROM [" & strWksOneName & "$] A, [" & strWksOtherName & "$] B", _
      "WHERE A.`Company Name` = B.`Company Name` AND A.`Contracted` = 'contracted'"), vbCr)
 
  Set objRS = CreateObject("ADODB.Recordset")
  objRS.Open strSQL, strConn
 
  Set objConnection = CreateObject("ADODB.Connection")
  With objConnection
    .Open strConn
    .Execute = "UPDATE [" & strWksOtherName & "$] SET `Previous Exhibitor` = 'no'"
 
    Do While Not objRS.EOF
      .Execute "UPDATE [" & strWksOtherName & "$] SET `Previous Exhibitor` = 'yes' WHERE `Company Name`='" & objRS.fields(0).Value & "'"
      objRS.movenext
    Loop
    .Close
  End With
  Set objRS = Nothing
  Set objConnection = Nothing
End Sub