'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@gmx.de
'Benutzung frei - ohne Gewähr
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  Vergleicht die Formelinhalte der GANZEN Spalte der aktiven Zelle des aktiven Blattes,
'+  mit der Quelle (= 2 oder mehr Spalten einer evtl anderen Tabelle) im Beispiel =
'+ Tabelle2 Spalte B bis E und zwar nach einer Übereinstimmung in Spalte C (=2.Spalte der Quelle!)
'+  und nimmt den Wert  - gleiche Zeile, aber Spalte B - und ersetzt den Formelinhalt im aktiven Blatt
'+  durch diese Formel.
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Sub suche_und_ersetze(quelle As Range, _
                                              c_match As Integer, _
                                              c_val As Integer)
Dim r As Range
Dim r1 As Range 'nicht benutzt, da Schlüssel EINDEUTIG!
Dim c As Range
Dim sel As Range
On Error GoTo err_gef

Set sel = ActiveSheet.UsedRange
Set sel = Intersect(sel, ActiveCell.EntireColumn)

For Each c In sel
Set r = quelle.Columns(c_match).Find(What:=c.FormulaLocal, LookAt:=xlWhole, _
                                                                    SearchOrder:=xlByRows, MatchCase:=True)

If Not r Is Nothing Then c.FormulaLocal = Intersect(r.EntireRow, quelle.Columns(c_val)).FormulaLocal
Next
MsgBox "Fertig!"
Exit Sub
err_gef:
MsgBox "Fehler"
End Sub

Sub test()
suche_und_ersetze Worksheets("Tabelle2").[B:E], 2, 1
End Sub