Haku koko työkirjasta ja tietyyn solun arvon tulokseksi

Sub HakeeKaikistaTaulukoista()
Dim ws As Worksheet
Dim Löydetty As Range
Dim Haku As String
Dim Tupla As Boolean
Dim kpl As Long
Dim i As Long
Dim C6Arvo As Variant
Dim Nimi As String
On Error Resume Next
'haettava tieto ( nyt Sheet1 taulukko, oletetaan aktiiviseksi, kuna makroa suoritetaan, muuta alempana nimi oikeaksi
Haku = Range("B3")
kpl = Worksheets.Count
For i = 1 To kpl
' muuta hakusolun taulukon nimi sopivaksi(ettei hae siitä...)
If Worksheets(i).Name <> "Sheet1" Then
With Worksheets(i).UsedRange
Set Löydetty = .Find(What:=Haku, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not Löydetty Is Nothing Then
If Tupla Then
C6Arvo = ""
Nimi = ""
GoTo loppu
End If
Tupla = True
C6Arvo = Worksheets(i).Range("C6")
Nimi = Worksheets(i).Name
End If
End With
End If
Next i
On Error GoTo 0
loppu:
'muuta taulukon nimi ja solut sopiviksi
Worksheets("Sheet1").Range("C6") = C6Arvo
Worksheets("Sheet1").Range("D6") = Nimi
End Sub

Keep EXCELing
@Kunde

Kuulostaa sellaiselta puuhalta, joka tehdään sql:ssä unionilla.

Taulu1
--
ID Arvo
1 1
2 2
3 3

Taulu2
--
ID Arvo
1 2
4 4
5 5

SELECT Arvo FROM T1 UNION SELECT Arvo FROM T2;
--
Arvo
1
2
3
4
5