Hallo,

ich habe jetzt alle Formeln erstellt, welche ich für meine Projektarbeit benötige.

Bei 3 Stück komme ich leider nicht zum Ziel und die Zeit läuft mir leider davon.

Ich wäre sehr dankbar, wenn wir jemand aus diesen Forum helfen könnte.

Formel 1:

Dim ggge As Long
Dim gggf As Long
With Worksheets("Sheet1")
  ggga = .Range("LA1").Column
  gggb = .Range("BOJ1").Column
  gggc = .Range("BQC1").Column
  gggd = .Range("DTL1").Column
  For ggge = ggga To gggb
  For gggf = gggc To gggd
    If .Cells("BPK2").Value = .Cells("HX2") And _
    .Cells(ggge, 3).Value = "0" And _
    .Cells(gggf, 3).Value = 1 And _
    .Cells(ggge, 1).Value >= .Cells(ggge, 36) And _
    .Cells(ggge, 1).Value <= .Cells(ggge, 37) Then
      .Cells(ggge, 5).Value = "1"
    Else
      .Cells(ggge, 5).Value = "0"
End If
Next
End With

Formel 2:

With Worksheets("Sheet1")
Dim gggq As Long
Dim gggn As Long
Dim gggo As Long
For gggq = 12 To 13
gggj = .Range("LA1").Column
gggk = .Range("BOJ1").Column
gggl = .Range("BQC1").Column
gggm = .Range("DTL1").Column
For gggn = gggj To gggk
For gggo = gggl To gggm
If .Cells(gggn, 3).Value = "1" And _
.Cells(gggn, 12).Value > "" Then
.Range(gggn, gggq).Copy .Range(gggo, 13)
End If
Next
End With

Formel 3:

Dim zzza As Long
Dim zzzf As Long
Dim zzzg As Long
zzzb = Worksheets("Sheet1").Range("DTY1").Column
zzzc = Worksheets("Sheet1").Range("FXH1").Column
zzzd = Worksheets("Sheet2").Range("F1").Column
zzze = Worksheets("Sheet2").Range("BCO").Column
For zzza = 4 To 3951
For zzzf = zzzb To zzzc
For zzzg = zzzd To zzze

If Worksheets("Sheet1").Cells(zzzf, zzza).Value = "100" Then
Worksheets("Sheet2").Cells(zzzg, zzza).Interior.ColorIndex = 19
End If
Next

Sollte Fragen zu einzelnen Formeln auftauchen stehe ich gerne für Nachfragen zur Verfügung.