Feld kopieren mit Logik

Private Sub Bearbeiter()
Dim intZaehler1 As Integer
Dim intZaehler2 As Integer
Dim lngLZeile As Long
Dim strQuelle As String
Dim strBearbeiter As String
Dim strBatch As String
Dim strInbe As String
Dim strMuss As String
Dim strCR As String
Dim lngNummer As Long
strBatch = "Batchänderung"
strInbe = "Inbetriebnahmeschritt"
strMuss = "Mussschritt"
strCR = "CR"
lngLZeile = Worksheets("TODO").Cells(Rows.Count, 1).End(xlUp).Row
For intZaehler1 = 2 To lngLZeile
Select Case Cells(intZaehler1, 2).Value
Case strBatch
strBearbeiter = Cells(intZaehler1, 5).Value
lngNummer = Cells(intZaehler1, 3).Value
For intZaehler2 = 2 To lngLZeile
Select Case Cells(intZaehler2, 3).Value
Case lngNummer
If Cells(intZaehler2, 2).Value = strBatch Or Cells(intZaehler2, 2). _
Value = strInbe Or Cells(intZaehler2, 2).Value = strMuss Or Cells(intZaehler2, 2).Value = strCR  _
_
Then
Cells(intZaehler2, 5).Value = strBearbeiter
End If
End Select
Next
Case strInbe
strBearbeiter = Cells(intZaehler1, 5).Value
lngNummer = Cells(intZaehler1, 3).Value
For intZaehler2 = 2 To lngLZeile
Select Case Cells(intZaehler2, 3).Value
Case lngNummer
If Cells(intZaehler2, 2).Value = strBatch Or Cells(intZaehler2, 2). _
Value = strInbe Or Cells(intZaehler2, 2).Value = strMuss Or Cells(intZaehler2, 2).Value = strCR  _
_
Then
Cells(intZaehler2, 5).Value = strBearbeiter
End If
End Select
Next
Case strMuss
strBearbeiter = Cells(intZaehler1, 5).Value
'Call MsgBox(" " & Cells(intZaehler1, 5).Value)
lngNummer = Cells(intZaehler1, 3).Value
For intZaehler2 = 2 To lngLZeile
Select Case Cells(intZaehler2, 3).Value
Case lngNummer
If Cells(intZaehler2, 2).Value = strBatch Or Cells(intZaehler2, 2). _
Value = strInbe Or Cells(intZaehler2, 2).Value = strMuss Or Cells(intZaehler2, 2).Value = strCR  _
_
Then
If Len(Cells(intZaehler2, 5).Value) = 0 Then
Cells(intZaehler2, 5).Value = strBearbeiter
End If
End If
End Select
Next
End Select
Next
End Sub