Private Sub Кнопка23_Click()
    Dim k, m, db As Database
    Set db = CurrentDb
    k = CopySelectedd(Me.Form, Me.listSubjectt)
    m = CopySelected(Me.Form, Me.listSubject)
    db.QueryDefs("Запрос и сточник(ЕДДС)").SQL = _
    "Select * From [Данные о состоянии ЕДДС] " _
    & "Where [Код субъекта] In (" & m & ")"
End Sub

Function CopySelectedd(frm As Form, ctl As Control) As String
    Dim ctlSource As Control
    Dim ctlDest As Control
    Dim strItems As String
    Dim intCurrentRow As Integer
    Set ctlSource = frm(ctl.Name)
    For intCurrentRow =  0  To ctlSource.ListCount -  1 
        If ctlSource.Selected(intCurrentRow) Then
            strItems = strItems & ctlSource.Column( 0 , intCurrentRow) & ","
        End If
    Next intCurrentRow
    CopySelectedd = Left(strItems, Len(strItems) -  1 )
'    ctlDest.RowSource = ""
'    ctlDest.RowSource = strItems
End Function
Function CopySelected(frm As Form, ctl As Control) As String
    Dim ctlSource As Control
    Dim ctlDest As Control
    Dim strItems As String
    Dim intCurrentRow As Integer
    Set ctlSource = frm(ctl.Name)
    For intCurrentRow =  0  To ctlSource.ListCount -  1 
        If ctlSource.Selected(intCurrentRow) Then
            strItems = strItems & ctlSource.Column( 0 , intCurrentRow) & ","
        End If
    Next intCurrentRow
'    ctlDest.RowSource = ""
'    ctlDest.RowSource = strItems
End Function

    For intCurrentRow =  0  To ctlSource.ListCount -  1 
        If ctlSource.Selected(intCurrentRow) Then
            strItems = strItems & "[" & ctlSource.Column( 0 , intCurrentRow) & "],"
        End If
    Next intCurrentRow
    CopySelectedd = Left(strItems, Len(strItems) -  1 )