Prozedur & Funktion ???

Public Sub Transfer(Typ As String)
'Daten löschen
Range("A2", "D21").Select
Selection.ClearContents
Range("A1").Select
'Farbtyp
Select Case Typ
Case "Alt"
cl = clAlt
tblID = 3
Case "LZ"
cl = clLZ
tblID = 4
Case "63er"
cl = cl63er
tblID = 4
End Select
'relevante Daten übertragen
j = 1
With Sheets("Daten")
For i = 2 To .UsedRange.Rows.Count
If (.Cells(i, 3).Value = Typ) And (.Cells(i, 2).Value = .Range("F1").Value) Then
j = j + 1
Sheets("Rückmeldung").Cells(j, 1) = .Cells(i, 4).Value
Sheets("Rückmeldung").Cells(j, 2) = .Cells(i, 5).Value
End If
Next
End With
'Durchchecken
Dim time1 As Date
Dim time2 As Date
time2 = 0
Dim Doppelt As Boolean
Doppelt = False
For i = 2 To j
For k = 24 To Sheets("Rückmeldung").UsedRange.Rows.Count
If Cells(i, 2).Value = Cells(k, 1).Value Then
'Spalte farblich markieren
With Rows(k & ":" & k).Interior
.ColorIndex = cl
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'auf Menge prüfen
Cells(i, 3).Value = Cells(i, 3).Value + CInt(Cells(k, 10).Value) / CInt(Cells(k, _
_
3).Value)
'auf Reihenfolge prüfen
time1 = CDate(Cells(k, 7).Value)
If time1 + "00:59" > time2 Then
Cells(i, 4).Value = 1
Else
Cells(i, 4).Value = 0
End If
time2 = time1
End If
Next
Next
End Sub
Public Sub DoWert(tblID As Integer, Menge, Seq, Ges As Double)
With Sheets(tblID)
For i = 21 To 43
If Format(.Cells(i, 1).Value, "DD.MM.YYYY") = Format(Date, "DD.MM.YYYY") Then
.Cells(i, 2).Value = Menge
.Cells(i, 3).Value = Seq
.Cells(i, 4).Value = Ges
End If
Next
End With
End Sub
Public Sub Alle()
Transfer ("Alt")
DoWert(2,Range("C22").Value,Range("D22").Value,Range("E22").Value)
Transfer ("LZ")
End Sub