Option Explicit
Sub NurWerteVonNach()
Dim strQuelle As String
Dim lngRow As Long, lngCol As Long
Dim arrTo() As Variant
Dim SpalteWo As Long
Dim SpalteWas As Variant
Dim x As Long
Dim rngto As Long
strQuelle = Sheets("Übersicht").Range("A1").Value
SpalteWo = 47
SpalteWas = "ja"
With Sheets(strQuelle)
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
lngCol = .Cells.Find("*", .Cells(1), -4123, 2, 2, 2, False).Column
arrTo = .Range(.Cells(1, 1), .Cells(lngRow, lngCol)).Value
End With
With Sheets("Übersicht")
For x = LBound(arrTo, 1) To UBound(arrTo, 1)
If arrTo(x, SpalteWo) = SpalteWas Then
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row + 1
.Cells(lngRow, 1).Value = arrTo(x, 1)
.Cells(lngRow, 4).Value = arrTo(x, 4)
End If
Next x
End With
End Sub