den code kopierst du in das codemodul des betreffenden Arbeitsblattes sobald eine Zelle ausgewählt wird, macht er sein Ding.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'target ist die gerade ausgewählte zelle
If Target.CountLarge > 1 Then Exit Sub
If Target.Column = 1 Or Target.Column = 2 Then 'spalte A oder B
If Target.Row > 1 And Target = "" Then 'ist zelle leer
'ist Zelle oben drüber nicht leer
If Target.Offset(-1) <> "" Then formelnschreiben
End If
End If
End Sub
Sub formelnschreiben()
Dim arSp, itm, rng As Range, i As Long, bolisformula As Boolean
Dim stextformula As String
Dim lrow As Long
'Array mit den zu ersetzenden Spaltennummern
arSp = Split("G,H,I,K,M,O", ",")
lrow = ActiveCell.Row
Application.EnableEvents = False
On Error GoTo ERRORHANDLING
For Each itm In arSp
Set rng = Intersect(UsedRange, Columns(itm))
If rng Is Nothing Then Exit Sub
For i = rng.Rows.Count To 1 Step -1
If rng(i, 1).HasFormula Then
'wenn formel gefunden dann ersetzen der ersten drei Vorkommen der Zeilennummnern
'=WENN(ODER(A281="";B281="");"";WENNFEHLER(SVERWEIS(F281;KundenDBEM;2;0);"Fehler"))
stextformula = rng(i, 1).FormulaLocal
stextformula = Replace(stextformula, CStr(rng(i, 1).Row), CStr(lrow), , 3)
'geänderte Formel in zelle schreiben
Cells(lrow, itm).FormulaLocal = stextformula
Exit For
End If
Next
Next
ERRORHANDLING:
Application.EnableEvents = True
End Sub
|