Mehrere Bereiche füllen wenn leer (VBA grob vorhanden)

[kingkong]

ich würde gerne in mehrere Bereiche was verschiedenes eintragen,wenn die Zellen darin leer sind.

jetzt habe ich 2 Makros gefunden mit dem das machbar wäre.

habe mich auch bissl belesen um sie zu verstehen aber VBA ist wirklich etwas kompliziertes für einen Einsteiger.

Dieses funktionierte aber leider nur bei einem Bereich.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Bereich As Range
      Set Bereich = Range("G19:G34")
           If Not Intersect(Target, Bereich) Is Nothing Then
         If IsEmpty(Target) Then
            Target.Value = "Art.Nr. eingeben"
         End If
      End If
End Sub


nun meine Frage ist dieses erweiterbar auf 3 - 4 Bereiche?

Danke euch und noch schöne Pfingsten gewünscht

[RPP63]

Moin!
Ich zeige Dir mal, wie ich so etwas manuell mache:
• Ich markiere die einzelnen Bereiche nacheinander mit der Maus bei gedrückter Strg-Taste
• F5 → Inhalte → Leerzellen (markiert alle leeren Zellen im zusammengesetzten Bereich)
• "Art.Nr. eingeben" (ohne "") eintippen und mit Strg+Enter bestätigen
• Fettich!

Wenn Du dabei den Rekorder laufen lässt, hast Du ein Gerüst, wenn Du unbedingt VBA einsetzen willst.
[da steht dann etwas von SpecialCells(xlCellTypeBlanks)]

Habs jetzt mal gemacht:

Sub Makro1()
' 
' Makro1 Makro 
' 

' 
    Range("E3:E23,H5:H9,H16:H23").Select
    Range("H16").Activate
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "Dingens!"
End Sub

Jetzt noch das Überflüssige rauswerfen …

Gruß Ralf

[kingkong]

Danke Dir und wird sofort probiert also als erstes das ohne Makro

[kingkong]

ohne Makro ging nicht

Private Sub Worksheet_Change(ByVal Target As Range)

        Range("O3:O7,Q3:Q7").Select
        Range("O3").Activate
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.FormulaR1C1 = "FIN.eingeben"


End Sub


so füllt er die Zelle die ich lösche meckert aber rum wen in den anderen Zellen noch was steht und zwar hier

Selection.SpecialCells(xlCellTypeBlanks).Select

[RPP63]

Jo, wenn er keine leeren Zellen findet, läuft dies in einen Laufzeitfehler.

Klassenmodul der Tabelle:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("O3:O7,Q3:Q7")) Is Nothing Then
  Call Makro1
End If
End Sub

Allgemeines Modul:

Code:

Sub Makro1()
On Error Resume Next
Range("O3:O7,Q3:Q7").SpecialCells(xlCellTypeBlanks).Value = "Dingens!"
On Error GoTo 0
End Sub

[kingkong]

Danke so gehts 

und nur noch eine Frage besteht die Möglichkeit in F6 etwas anderes einzutragen ?

[RPP63]

Ja, warum auch nicht?
Schließlich wird F6 doch gar nicht vom Intersect() abgedeckt.

[kingkong]

Aber auch mit diesem Makro


also gleichzeitig egal wo etwas leer wird

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("O3:O7,Q3:Q7")) Is Nothing Then
  Call Makro1
If Not Intersect(Target, Range("F6")) Is Nothing Then
  Call Makro2
End If
End Sub

[RPP63]

Dann musst Du doch nur
Intersect(Target, Range("O3:O7,Q3:Q7"))
erweitern mit
Intersect(Target, Range("O3:O7,Q3:Q7,F6"))

[kingkong]

ich denke wir reden aneinander vorbei aber belehr mich falls ich hier was falsch mache also wenn (O3 bis O7und Q3 bis Q7 leer ist dann abc , wenn aber F6 leer ist dann cde)

das meinte ich 

DANKE