Sub DoIt()
Dim Conn As New ADODB.Connection, This_WB As Workbook
Set This_WB = ThisWorkbook
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
'=== Объединение
Sheets("Или так").Range("H4").CopyFromRecordset _
Conn.Execute(" SELECT A.Множество1 FROM [Или так$B3:B9] A INTERSECT SELECT B.Множество2 FROM [Или так$D3:D7] B INTERSECT SELECT C.Множество3 FROM [Или так$F3:F10] C")
End Sub