Kopieren von Kommentaren aus mehreren Sheets

Sub KommentareInNeuesBlattSchreiben()
Dim wksMitKommentaren As Worksheet  'die Tabelle mit Kommentaren
Dim wksAusdruck As Worksheet        'die Tabelle zum Ausdrucken
Dim cmtDieser As Comment            'ein Kommentar
Dim lngZeile As Long
Dim varTab(2) As Variant
varTab(0) = "p1"
varTab(1) = "p2"
varTab(2) = "fragen"
Sheets(varTab).Select
Set wksMitKommentaren = Selected.Sheets     'Achtung, vorher merken, weil neues Blatt kommt
Set wksAusdruck = Worksheets("Änderungen")
Sheets("Änderungen").Range("a1:F100").Clear
With wksAusdruck
'Titelzeile schreiben:
lngZeile = 1
.Cells(lngZeile, 1).Value = "Adresse"           'vor jeden führenden Punkt wird  _
wksAusdruck gesetzt wegen "With"
.Cells(lngZeile, 2).Value = "Finaler Eintrag"
.Cells(lngZeile, 3).Value = "Kommentarverlauf"
.Rows(lngZeile).Font.Bold = True     'Titelzeile fett machen
For Each cmtDieser In wksMitKommentaren.Comments    'alle Kommentare durchlaufen und in  _
_
neuer Tabelle auflisten
lngZeile = lngZeile + 1
.Cells(lngZeile, 1).Value = cmtDieser.Parent.AddressLocal
.Cells(lngZeile, 2).Value = cmtDieser.Parent.Value
.Cells(lngZeile, 3).Value = cmtDieser.Text
.Cells(lngZeile, 4).Value = cmtDieser.Shape.Fill.Transparency
Next
End With
Sheets("änderungen").Select
Rows("1:100").Select
Selection.Rows.AutoFit
End Sub