Hallo zusammen,

Yal hat mir dieses wunderbare Programm geschrieben, das auch hervorragend funktioniert. Leider ist mein alter Thread nun abgelegt und ich kann ihn nicht mehr reaktivieren. Ich benötige jedoch noch eine Erweiterung:
Nachdem die Daten in die Zieldatei übertragen wurden, müssen die Daten von A5 bis J300 nach Datum, also Spalte A sortiert werden, da die Reisekostenabrechnungen nicht in zeitlich korrekter Reihenfolge eingegeben werden. Ich weiß nicht, an welcher Stelle ich das einbauen muss. Kann mir jemand helfen?


Sub TestUebertragGesamttabelle()
Dim Quelle As Worksheet
Dim ServiceMA As String
Dim ZielWB As Workbook

Set ZielWB = ActiveWorkbook 'man muss das Makro straten, während das Ziel-wb aktiv ist!!
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = False Then
Exit Sub 'der User hat den Dialog mit "Abbrechen" verlassen
Else
Set Quelle = Workbooks.Open(.SelectedItems(1)).Worksheets("Reisekosten")
ServiceMA = Zielblatt_finden(ZielWB, Quelle.Range("G3").Value)
If ServiceMA = "" Then
Quelle.Activate
MsgBox "Name der Service-Mitarbeiter wahrscheinlich falsch: " & Quelle.Range("G3").Value, , "Bitte prüfen"
Exit Sub
End If
End If
End With

With ZielWB.Worksheets(ServiceMA).Cells(Rows.Count, "A").End(xlUp)
If Quelle.Range("A8").Value > 0 Then
.Offset(1, 0).Value = Quelle.Range("A8").Value 'Datum
.Offset(1, 1).Value = Quelle.Range("N8").Value 'Abwesenheit
.Offset(1, 2).Value = Quelle.Range("O8").Value 'Spesen Neu
.Offset(1, 4).Value = Quelle.Range("P8").Value 'Spesen KU
.Offset(1, 7).Value = Quelle.Range("Q8").Value 'Frühstück
.Offset(1, 8).Value = Quelle.Range("R8").Value 'Mittag Abend
End If
If Quelle.Range("A9").Value > 0 Then
.Offset(2, 0).Value = Quelle.Range("A9").Value 'Datum
.Offset(2, 1).Value = Quelle.Range("N9").Value 'Abwesenheit
.Offset(2, 2).Value = Quelle.Range("O9").Value 'Spesen Neu
.Offset(2, 4).Value = Quelle.Range("P9").Value 'Spesen KU
.Offset(2, 7).Value = Quelle.Range("Q9").Value 'Frühstück
.Offset(2, 8).Value = Quelle.Range("R9").Value 'Mittag Abend
End If
End With
End Sub

Function Zielblatt_finden(WB As Workbook, Name) As String
Dim N
Dim Blattname As String
On Error Resume Next
For Each N In Split(Name)
Blattname = WB.Worksheets(N).Name
If Blattname > "" Then
Zielblatt_finden = Blattname
Exit Function
End If
Next
End Function