WICHTIG Lösung erstellt !!!!!!!!!!!!!!!!!!!!!!!!!!
08.12.2006 19:28:48
Walter
Hallo France,
habe die Lösung zusammengebastelt.
1. Wird als erstes die zu LETZT beschriebene Zelle durch die Spalte "A" ermittelt.
2. Da in die Spalte "F" in der die evtl. fehlenden Nr. stehen.
3. Somit wird der bereich ermittelt: Set bereich = Range("F6:" & az)
Hier das kompl.Makro funktioniert Super, teste doch mal !!!, bin Richtig STOLZ:
Sub Prüfen_ob_Leer()
Dim c As Range
Dim bereich As Range
Dim ErgBereich As Range
'---------- erst letzte Zelle ermitteln ---------
Dim zz As Long
Dim az
zz = 1
Do While Cells(zz, 1) <> "" ' Start der Schleife 1=Spalte A
zz = zz + 1 ' Schleifenzähler um 1 erhöhen
Loop ' Wendepunkt für Schleife
Cells(zz, 1).Select ' Zelle selektieren 1=in Spalte A anfang
ActiveCell.Offset(-1, 5).Select '1 Zeile nach oben, 4 Spalten n. Rechts
az = ActiveCell.Address
'MsgBox az
''Application.ScreenUpdating = False
ActiveSheet.Unprotect (getStrPasswort)
'Set bereich = Range("F6:F1000")
Set bereich = Range("F6:" & az)
For Each c In bereich
If IsEmpty(c) Then
Set ErgBereich = c
Exit For
End If
Next c
If ErgBereich Is Nothing Then
MsgBox "Keine leeren Zellen gefunden."
Else
For Each c In bereich
If IsEmpty(c) Then
Set ErgBereich = Application.Union(ErgBereich, c)
End If
Next c
ErgBereich.Select
Set ErgBereich = Nothing
Set bereich = Nothing
End If
Range("C6").Select
Range("B4").Select
''' Application.ScreenUpdating = True
End Sub
Schönes Wochenende!
mfg Walter