Hallo Harald.
Versuch es mit dieser zusaetzlichen Zeile:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Harald VBA-Forum
Dim lngLast As Long
Dim ws As Worksheet, wsInhalt As Worksheet
Set wsInhalt = ThisWorkbook.Sheets("Sheet2") 'Tabellenname anpassen
lngLast = wsInhalt.Cells(Rows.Count, 1).End(xlUp).Row
wsInhalt.Range("A2:A" & lngLast).ClearContents 'Startzeile anpassen, hier A2 wenn Ueberschrift vorhanden
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsInhalt.Name Then
If ws.Range("A1") <> "" Then
lngLast = wsInhalt.Cells(Rows.Count, 1).End(xlUp).Row 'Auflistung findet in Spalte A statt
wsInhalt.Cells(lngLast + 1, 1) = ws.Cells(1, 1)
End If
End If
Next
wsInhalt.Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub
Gruss Torsten
|