Datei Bereich schützen von Halo_Zi.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'* H. Ziplies                                     *
'* 06.08.10                                       *
'* erstellt von HajoZiplies@web.de                *
'* http://Hajo-Excel.de/
' ein bestimmter Bereich darf nicht ausgewählt werden
' Im Bereich D1:G75 darf eine ausgefüllte Zelle nicht noch mal
' gewählt werden.. Werden mehere Zellen markiert, wird Zeilenweise
' abgearbeitet und in der ersten ausgefüllten Spalte, die erste freie Zelle
' in der Spalte gewäht
Dim RaBereich As Range                  ' Variable für Bereich
Dim RaZelle As Range                    ' Variable für Zelle
' BoWert ist mit Definition False, bei True wurde eine Zelle gewählt
Dim BoWert As Boolean
Dim InI As Integer                      ' Variable für Spalte
Dim LoJ As Long                         ' Variable für letzte Zeile
Dim LoK As Long                         ' Variable für Zeile
' Bereich der Wirksamkeit
Set RaBereich = Range("D1:G75")
' noch mehr Bereiche
'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
'    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
'    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
'    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
'    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
'    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
'    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect "Passwort"
For Each RaZelle In RaBereich
If RaZelle  "" Then               ' Zellinhalt verschieden von leer
For InI = RaZelle.Column To 7
If InI = RaZelle.Column Then
LoK = RaZelle.Row + 1
Else
LoK = 1
End If
For LoJ = LoK To 75
If Cells(LoJ, InI) = "" Then
Cells(LoJ, InI).Select
BoWert = True
Exit For
End If
Next LoJ
If BoWert = True Then Exit For
Next InI
If BoWert = False Then
Range("A1").Select
MsgBox "Es wurde keine leere Zelle im Bereich gefunden"
End If
End If
Next RaZelle
'ActiveSheet.Protect "Passwort"
End If
Set RaBereich = Nothing                 ' Bereich leeren
End Sub