Hallo Melanie,
Code steht an richtiger Stelle, du hattest nur die Sub falsch benannt:
Gruß
Reinhard
**Private Sub CommandButton1\_Click** ()
Dim wSTAT As Worksheet, wAUSW As Worksheet
Dim aUr, aZiel()
Dim iUr As Long, iZiel As Long
Set wSTAT = Worksheets("BU Status")
Set wAUSW = Worksheets("BU Auswertung")
wAUSW.Range("A2:F10000").ClearContents ' löscht alte Werte in wAUSW
aUr = wSTAT.Range("D50:AY1401").Value
ReDim aZiel(UBound(aUr), 6)
For iUr = 1 To UBound(aUr)
If aUr(iUr, 18) = 1 Then
If aUr(iUr, 47) \> 2 Then
If InStr("#AV#ST#CH#DDC#", "#" & aUr(iUr, 48) & "#") \> 0 Then
aZiel(iZiel, 0) = aUr(iUr, 1) 'D
aZiel(iZiel, 1) = aUr(iUr, 9) 'L
aZiel(iZiel, 2) = aUr(iUr, 20) 'W
aZiel(iZiel, 3) = aUr(iUr, 21) 'X
aZiel(iZiel, 4) = aUr(iUr, 47) 'AX
aZiel(iZiel, 5) = aUr(iUr, 48) 'AY
iZiel = iZiel + 1
End If
End If
End If
Next iUr
If iZiel \> 0 Then wAUSW.Range("A2:F1352") = aZiel
'wAUSW.Columns.AutoFit 'entspricht autom. Spaltenbreite
End Sub
