Sub adressen_aktive1()    'Adresslisten Filter
LArt = "A"
Call druck_adress_listen1(LArt)
End Sub

Sub adressen_vorstand1() 'Adresslisten Filter
LArt = "x2"
Call druck_adress_listen1(LArt)
End Sub

Sub druck_adress_listen1(LArt As String)
Dim wshSta As Worksheet, wshDR As Worksheet, wshET As Worksheet
Dim SZähler As Integer, LZähler As Integer, i As Integer, iCol As Integer
LTitel = ""
Set wshET = Sheets("Et (2)")
Set wshDR = Sheets("Dr")
Set wshSta = Sheets("Sta")
Select Case LArt
Case "A": iCol = 14  ' Aktive
LTitel = "Aktivmitglieder"
Sheets("Dr").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Sheets("V").Visible = True
Sheets("V").Select
Sheets("V").Copy before:=Sheets(2)
Sheets("V (2)").Select
Sheets("V (2)").Name = "Dr"
Sheets("V").Visible = False
Case "x2": iCol = 37  ' Vostand
LTitel = "Vostand"
Sheets("Dr").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Sheets("V").Visible = True
Sheets("V1").Visible = True
Sheets("V1").Select
Sheets("V1").Copy before:=Sheets(2)
Sheets("V1 (2)").Select
Sheets("V1 (2)").Name = "Dr"
Sheets("V1").Visible = False
Case Else:    Exit Sub
End Select
Range("A1").Value = LTitel
SZähler = 3
For LZähler = 2 To 201
' Datensatz holen, nach LArt
If wshSta.Cells(LZähler, iCol).Value = LArt Then
' DS übernehmen
For i = 1 To 12
wshDR.Cells(SZähler, i) = wshSta.Cells(LZähler, i + 1)
Next i
SZähler = SZähler + 1
End If
Next LZähler
' Einträge sortieren
Sheets("Dr").Select
Range("A3:L" & SZähler - 1).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3"), _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
' Drucken
ActiveWindow.SelectedSheets.PrintPreview
antwort = MsgBox("Liste " & LTitel & " drucken ?", vbYesNo)
If antwort = 6 Then
Druck_Neu
End If
'    Mitgliederliste_form.Show
End Sub