Makro und Passwort

Private Sub CommandButton1_Click()
Dim wksQuelle As Worksheet
Dim rngRow As Range, rngSelektion As Range
Dim wbSammler As Workbook, wksSammler As Worksheet, rngZelle As Range
Dim vKey As Variant, lZeile As Long
'Spalte mit eindeutgem Schlüssel = Spalte B
Const SpalteKey As Long = 2
'Dateiname der Sammeldatei                                    -  anpassen !
Const sNameSammler As String = "\\\\Malibu\Projekte\SAP\300_Test\2011\110_Verwaltung\ _
20_Auswertungen\Workflow_GSZ_2011.xlsm"
'Blattname oder Nr des Tabellenblatts in Sammeldatei      - ggf. anpassen !
Const vBlattSammler = 1
On Error GoTo Fehler
'Quellblatt und Zell-Selektion Objekt-Variablen zuweisen
Set wksQuelle = ActiveSheet
Set rngSelektion = Selection
'1. Zeile des selektierten Bereichs prüfen
If rngSelektion.Row  Sammeldatei") = vbNo Then GoTo Beenden
'Bildschirmaktualisierung und Ereignismakros deaktivieren
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Sammeldatei öffnen
Set wbSammler = Workbooks.Open(Filename:=sNameSammler, Ignorereadonlyrecommended:=True)
Set wksSammler = wbSammler.Worksheets(vBlattSammler)
'Keys der Selektion in Sammeldatei suchen und Zeilen kopieren
For Each rngRow In rngSelektion.Rows
vKey = wksQuelle.Cells(rngRow.Row, SpalteKey).Value
Set rngZelle = wksSammler.Columns(SpalteKey).Find(What:=vKey, LookIn:=xlValues, _
lookat:=xlWhole)
With wksSammler
If rngZelle Is Nothing Then
'Neuer Schlüssel
lZeile = .Cells(.Rows.Count, SpalteKey).End(xlUp).Row + 1
Else
'vorhandener Schlüssel
lZeile = rngZelle.Row
End If
End With
wksQuelle.Rows(rngRow.Row).Copy Destination:=wksSammler.Rows(lZeile)
Next
wbSammler.Close savechanges:=True
Beenden:
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub