Thema: Namen definieren mit Makro | Herbers Excel-Forum

Hallo!
Hätte eine Frage:
Ist es möglich, Namen per Makro definieren und automatisch ergänzen zu lassen?
In der Beispieldatei sind in den gelb markierten Feldern "Hauptkonten" angeführt.
Darunter befinden sich in den grau markierten Feldern die dazugehörigen Unterkonten.
Ich möchte nun, dass Excel automatisch eine Namensdefinition vornimmt und zwar wie folgt:
Namen gem. Eintrag im gelben Feld; im beiligenden Beispiel "Auto", steht in Zelle A4; in "bezieht sich auf" sollte der Bereich von A5 bis A13 ausgewählt werden (Bereich immer 9zeilig, beginnend mit Zeile unter dem jeweiligen Namen).
Diese Prozedur sollte für alle weiteren Zeilen (bis Zeile 112) automatisch durchgeführt werden, d. h., wenn beispielsweise neue Konten in die gelb markierten Zellen eingepflegt werden (z. B. in Zelle A26 "Geschenke"), wäre es super, wenn man dies so einrichten könnte, dass die Namen automatisch hinzugefügt werden (jeweils mit dem 9zeiligen Bezug).
Ist so etwas überhaupt möglich?
Wäre für eine Antwort sehr dankbar.
LG
Tom
https://www.herber.de/bbs/user/66831.xls

Hallo!
Sorry, Dateischutz ist nun deaktiviert!
https://www.herber.de/bbs/user/66833.xls
LG
Thomas

Hallo
hier mal als Ansatz
https://www.herber.de/bbs/user/66835.xls

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Object
If Not Intersect(Target, Union(Range("A4"), Range("A15"), Range("A26"), Range("A37"), Range(" _
A48"), Range("A59"), Range("A70"), Range("A81"), Range("A92"), Range("A103"))) Is Nothing And Target.Count = 1 Then
Set Rng = Range(Target.Offset(2, 0), Target.Offset(9, 0))
If Target.Value <> "" Then Rng.Name = Target.Value
End If
End Sub

Gruß Matthias

Hallo Matthias!
Vielen Dank für deinen Lösungsvorschlag!
Werde ihn heute abend mal ausprobieren!
Danke für die Bemühungen und noch schönen Tag!
LG
Tom

Hallo

Code in einem Modul

Option Explicit
Public OldName As String

---

Code in Tabelle1

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim obj As Object
Dim MyNames As Name
If Not Intersect(Target, Union(Range("A4"), Range("A15"), Range("A26"), Range("A37"), Range(" _
A48"), Range("A59"), Range("A70"), Range("A81"), Range("A92"), Range("A103"))) Is Nothing And Target.Count = 1 Then
For Each MyNames In ThisWorkbook.Names
If MyNames.Name = OldName Then
MyNames.Delete
Exit For
End If
Next
Set obj = Range(Target.Offset(2, 0), Target.Offset(9, 0))
If Target.Value <> "" Then
obj.Name = Target.Value
End If
Set obj = Nothing
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Union(Range("A4"), Range("A15"), Range("A26"), Range("A37"), Range(" _
A48"), Range("A59"), Range("A70"), Range("A81"), Range("A92"), Range("A103"))) Is Nothing And Target.Count = 1 Then
OldName = Target.Value
End If
End Sub

---

https://www.herber.de/bbs/user/66838.xls
Gruß Matthias