AW: Mehrfachauswahl im Worksheetchange
29.10.2006 10:40:29
Erich
Hallo floh,
warum willst du unbedingt die Formeln durch Werte ersetzen? Wenn du das nicht tust, erledigen sich 3. und 4. ganz von selbst...
(In Spalte B muss nur in den richtigen Zeilen "=INDEXZ" stehen.)
Ich würde das so machen:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngB As Range, rg As Range, zz As Long
Set rngB = Intersect(Target, Rows("5:65536"), Union(Columns("D"), Columns("F:G")))
If rngB Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rg In rngB
zz = rg.Row
If IsEmpty(Cells(zz, 1)) Then ' #1: wenn Zelle in Sp. A leer
Range(Cells(4, 2), Cells(4, 3)).Copy ' aus #3: Formeln auch aus C
Cells(zz, 2).PasteSpecial xlPasteFormulas
Cells(4, 5).Copy
Cells(zz, 5).PasteSpecial xlPasteFormulas
Range(Cells(4, 8), Cells(4, 10)).Copy
Cells(zz, 8).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
' ' zu #3 und #4: Formeln bleiben stehen
' Range(Cells(rg.Row, 2), Cells(rg.Row, 3)) = _
' Range(Cells(rg.Row, 2), Cells(rg.Row, 3)).Value
' Cells(rg.Row, 5) = Cells(rg.Row, 5)
' Range(Cells(rg.Row, 8), Cells(rg.Row, 10)) = _
' Range(Cells(rg.Row, 8), Cells(rg.Row, 10)).Value
End If
Next rg
rngB.Cells(1).Offset(1, 0).Select ' #2: Cursor nach unten
Application.EnableEvents = True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort