Ik heb een listing gemaakt die de oneven regels sorteert

mijn eerste versie is volgens mij goed maar bij het terug plaatsen van de gesorteerde array gaat het fout, doet niks. Heb van alles geprobeerd, maar hier houd mijn kennis toch ook op.

hier mijn code:
Option Base 1

Function Sorteer(Gebied As Range) As Long
  Dim Bladnaam As String, Begin As Long, Eind As Long, Kolom As Long, Teller As Long
  Dim Tijd() As Date, h As Long
 
  Bladnaam = Gebied.Worksheet.Name
  Begin = Gebied.Row
  Eind = Gebied.Rows.Count
  Kolom = Gebied.Column
 
 
 
  h = 1
  For Teller = Begin To Eind Step 2
    ReDim Preserve Tijd(h)
    Tijd(h) = Sheets(Bladnaam).Cells(Teller, Kolom)
    h = h + 1
  Next Teller
 
  Call SorteerArray(Tijd())
 
  h = 1
  For Teller = Begin To Eind Step 2
    Sheets(Bladnaam).Cells(Teller, Kolom + 1) = Tijd(h)
    **** Deze bovenstaande regel wil het niet doen ******
    **** voor de rest werkt alles perfect, zie volgende listing *****
    h = h + 1
  Next Teller

  Sorteer = 0
End Function


Function SorteerArray(TempArray As Variant)
  Dim MaxVal As Variant
  Dim MaxIndex As Integer
  Dim i, j As Integer

  For i = UBound(TempArray) To 1 Step -1
    MaxVal = TempArray(i)
    MaxIndex = i

    For j = 1 To i
      If TempArray(j) > MaxVal Then
          MaxVal = TempArray(j)
          MaxIndex = j
      End If
    Next j

    If MaxIndex < i Then
      TempArray(MaxIndex) = TempArray(i)
      TempArray(i) = MaxVal
    End If
  Next i

End Function

Nu heb ik de versie iets aangepast en dat is dit geworden
deze werkt maar is niet echt flexibel omdat je niet via het excelblad je gebied kan selecteren
Option Base 1

Sub OnEvenSort()
  Dim Teller As Long, Bladnaam As String, Begin As Long, Eind As Long, Kolom As Long
  Dim Tijd() As Variant, h As Long
 
  Bladnaam = "Blad1"
  Kolom = 1
 
  Eind = Range("A65536").End(xlUp).Row
 
  h = 1
  ReDim Tijd(h)
  For Teller = 1 To Eind Step 2
   Tijd(h) = Sheets(Bladnaam).Cells(Teller, Kolom)
   h = h + 1
   ReDim Preserve Tijd(h)
  Next Teller
 
  Call SorteerArray(Tijd())

  h = 1
  For Teller = 1 To 7 Step 2
    Sheets(Bladnaam).Cells(Teller, Kolom).Value = Tijd(h)
    h = h + 1
  Next Teller
End Sub

De Functie SorteerArray heb ik nu weggelaten omdat die hetzelfde is

bij functie 1 kun je alles uitlezen geen problemen alleen het terugschrijven werkt niet. Terwijl in listing 2 exact dezelfde code is en het daar wel werkt

Wie weet daar de oplossing voor