Vorsicht, du hast da was falsch verstanden!
11.02.2013 20:55:06
mike49
Hallo Klaus,
das habe ich verstanden.
Mit diesem Makro wird mein Inhaltsverzeichnis sortiert:
Sub SortierenTitel()
Dim wksOriginal As Worksheet, wksSort As Worksheet
Dim wbk As Workbook
Dim lngZeileMax As Long, lngZeile As Long, intPos As Integer
Dim strBS As String
Set wbk = ActiveWorkbook
Set wksOriginal = ActiveSheet
Application.ScreenUpdating = False
'temporäres Blatt zum Sortieren anlegen
wbk.Worksheets.Add after:=wbk.Sheets(wbk.Sheets.Count)
Set wksSort = wbk.Sheets(wbk.Sheets.Count)
'Originaldaten in temporäres Blatt kopieren
With wksOriginal
lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(lngZeileMax, 3)).Copy _
Destination:=wksSort.Cells(1, 1)
.Range(.Cells(2, 5), .Cells(lngZeileMax, 7)).Copy _
Destination:=wksSort.Cells(1 * (lngZeileMax - 1) + 1, 1)
.Range(.Cells(2, 9), .Cells(lngZeileMax, 11)).Copy _
Destination:=wksSort.Cells(2 * (lngZeileMax - 1) + 1, 1)
End With
With wksSort
'Sortieren nach Titel
With .Range(.Cells(1, 1), .Cells(3 * (lngZeileMax - 2), 3))
.Sort Key1:=.Range("B1"), order1:=xlAscending, Header:=xlNo
End With
'nicht benutzte Zeilen löschen
.Range(.Cells(.Rows.Count, 1).End(xlUp), _
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 2)).ClearContents
'1. Buchstabe im Titel fett, wenn 1. Buchstabe wechselt
strBS = ""
For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If strBS Left(.Cells(lngZeile, 2).Text, 1) Then
.Cells(lngZeile, 2).Characters(1, 1).Font.Name = "Arial Black"
strBS = Left(.Cells(lngZeile, 2).Text, 1)
End If
Next
'Daten wieder ins Original kopieren
.Range(.Cells(1, 1), .Cells(lngZeileMax - 1, 3)).Copy _
Destination:=wksOriginal.Cells(2, 1)
.Range(.Cells(1 * (lngZeileMax - 1) + 1, 1), .Cells(2 * (lngZeileMax - 1), 3)).Copy _
Destination:=wksOriginal.Cells(2, 5)
.Range(.Cells(2 * (lngZeileMax - 1) + 1, 1), .Cells(3 * (lngZeileMax - 1), 3)).Copy _
Destination:=wksOriginal.Cells(2, 9)
'temporäres Blatt wieder löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
wksOriginal.Activate
Application.ScreenUpdating = True
End Sub
Ich möchte nun, nachdem ich das sortierte Blatt ausgedruckt habe, den ursprünglichen Zustand des Blattes wiederherstellen. Wie würdest du das machen?
Gruß
mike49