Sub Tagesprofil1()

Dim Zeile As Long
Dim ZeileMax As Long
Dim ZeileMAx1 As Long
Dim n As Long
Dim m As Long
Dim st1 As Long
Dim tz As Long
Dim tz1 As Long
Dim tzMax As Long
Dim tzUhr As Date
Dim tzh As Long
Dim tzm As Long
Dim tzs As Long
Dim tzh1 As Long
Dim tzm1 As Long
Dim tzs1 As Long
Dim tzZahl As Double
Dim tzZahl1 As Double


st1 = 1
tzMax = 24


With Tabelle11 'Tabelleninhalt vor Suche löschen.
ZelleMax = .UsedRange.ClearContents

With Tabelle12 'Wegetabelle
ZeileMax = .UsedRange.Rows.Count
n = 1

With Tabelle11 'Tagesprofil 1
ZeileMAx1 = .UsedRange.Rows.Count
m = 1

For Zeile = 1 To ZeileMax

If Tabelle12.Cells(Zeile, 3).Value = st1 Then
     Tabelle12.Cells(Zeile, 11).Copy Destination:=Tabelle11.Cells(n, 2) 'Startzeitpunkt
     Tabelle12.Cells(Zeile, 12).Copy Destination:=Tabelle11.Cells(n, 4) 'Startgemeinde
     Tabelle12.Cells(Zeile, 34).Copy Destination:=Tabelle11.Cells(n, 6) 'Hauptverkehrsmittel
     Tabelle12.Cells(Zeile, 36).Copy Destination:=Tabelle11.Cells(n, 3) 'Zielzeitpunkt
     Tabelle12.Cells(Zeile, 37).Copy Destination:=Tabelle11.Cells(n, 5) 'Zielgemeinde
     Tabelle12.Cells(Zeile, 42).Copy Destination:=Tabelle11.Cells(n, 7) 'Wegdauer
     Tabelle12.Cells(Zeile, 44).Copy Destination:=Tabelle11.Cells(n, 8) 'Weglänge
     n = n + 1
End If

Next Zeile

'Tageszeit 1 - 24 h
For tz = 1 To tzMax
Cells(tz, 1) = tz

'Startzeitpunkt
tzUhr = Tabelle11.Cells(tz, 2).Value
tzh = Format(tzUhr, "h") 'nur Stunden
tzm = Format(tzUhr, "n") 'nur Minuten
tzs = Format(tzUhr, "s") 'nur Sekunden

tzZahl = tzh + (tzm / 60) + (tzs / 60) 'Uhrzeit von hh:mm:ss in 0,00 umwandeln
Tabelle11.Cells(tz, 9) = tzZahl

'Ankunftszeitpunkt
tzUhr = Tabelle11.Cells(tz, 3).Value
tzh1 = Format(tzUhr, "h") 'nur Stunden
tzm1 = Format(tzUhr, "n") 'nur Minuten
tzs1 = Format(tzUhr, "s") 'nur Sekunden

tzZahl1 = tzh + (tzm / 60) + (tzs / 60) 'Uhrzeit von hh:mm:ss in 0,00 umwandeln
Tabelle11.Cells(tz, 10) = tzZahl1
Tabelle11.Cells(tz, 11) = tzh

If Tabelle11.Cells(tz, 1).Value <= tzZahl Then
 Tabelle11.Cells(tz, 9).Copy Destination:=Tabelle11.Cells(m, 2)
 m = m + 1
End If

Next tz


End With
End With
End With
End Sub