Namen definieren mit Makro

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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

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

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread