Option Explicit
Sub NurWerteVonNach()
'nur Spalte A u. D
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
'Quellangabe
strQuelle = Sheets("Übersicht").Range("A1").Value
'Kriterien
SpalteWo = 47
SpalteWas = "ja"
'tatsächlich Benutztes - Werte in Datenfeld
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
'auswerten und schreiben
With Sheets("Übersicht")
For x = LBound(arrTo, 1) To UBound(arrTo, 1)
'Bedingung
If arrTo(x, SpalteWo) = SpalteWas Then
'Zielzeile
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row + 1
'Auswahl A u. D schreiben (Spalte 1 u. Spalte 4)
.Cells(lngRow, 1).Value = arrTo(x, 1)
.Cells(lngRow, 4).Value = arrTo(x, 4)
End If
Next x
End With
End Sub
|