Per VBA Namen vergeben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim n As Name If Target.Row = 1 Then If Application.CountIf(Sh.Rows(1), Target) > 1 Then Application.Undo Else On Error Resume Next Set n = ThisWorkbook.Names.Item(Target.Offset(1, 0).Name.Name) On Error GoTo 0 If Not n Is Nothing Then n.Delete If Target "" Then Target.Offset(1, 0).Name = Sh.Name & "_" & Target End If End If End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim n As Name Select Case Sh.Name Case "Mitarbeiter", "Produkte" If Target.Row = 1 Then If Application.CountIf(Sh.Rows(1), Target) > 1 Then Application.Undo Else On Error Resume Next Set n = ThisWorkbook.Names.Item(Target.Offset(1, 0).Name.Name) On Error GoTo 0 If Not n Is Nothing Then n.Delete If Target "" Then Target.Offset(1, 0).Name = Sh.Name & "_" & Target End If End If End Select End Sub

Hallo,
wahrscheinlich eher keine Zeit.
b)


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim n As Name
Select Case Sh.Name
Case "Mitarbeiter", "Produkte"
If Target.Row = 1 And Target.Cells.Count = 1 Then
If Application.CountIf(Sh.Rows(1), Target) > 1 Then
Application.Undo
Else
On Error Resume Next
Set n = ThisWorkbook.Names.Item(Target.Offset(1, 0).Name.Name)
On Error GoTo 0
If Not n Is Nothing Then n.Delete
If Target  "" Then Target.Offset(1, 0).Name = Sh.Name & "_" & Target
End If
End If
End Select
End Sub


Sub tt()
Dim wks As Worksheet, c As Range
For Each wks In Worksheets
For Each c In wks.Rows(1).SpecialCells(xlCellTypeConstants)
c = c.Value
Next
Next
End Sub

Das Löschen von Spalten wird dir 'kaputte' Namen bescheren.
Breinigen kannst du das hiermit:


Sub ttt()
Dim n As Name
For Each n In ThisWorkbook.Names
If InStr(n.RefersTo, "#REF!") > 0 Then n.Delete
Next
End Sub

Gruß ausm Pott
Udo

Hallo Udo,
funktioniert alles soweit ganz gut. Jetzt gibt es jedoch ein weiteres Problem: Die in dieser Datei erstellten sheets werden per Makro in andere Dateien kopiert. In diesen Dateien sollen nun die Namen auch vergeben werden. Da ich die sheets folgendermassen kopiere (Auszug):
...
Set wsQuelle = Workbooks(strDatei).Worksheets(strBlatt)
Set wsZiel = ThisWorkbook.Worksheets(strBlatt)
'Daten in den Zielblättern löschen
strBereich = "A1:" & wsZiel.Cells.SpecialCells(xlCellTypeLastCell).Address
wsZiel.Range(strBereich).Clear
'Daten kopieren
strBereich = "A1:" & wsQuelle.Cells.SpecialCells(xlCellTypeLastCell).Address
wsQuelle.Range(strBereich).Copy wsZiel.Cells(1, 1)
wsZiel.Range(strBereich).Value = wsZiel.Range(strBereich).Value
...
werden die Namen nicht mitkopiert. Ich bräuchte also für diese Dateien ein Makro, das nach dem Kopieren der Daten für die Zeile 1/2 das gleiche durchführt, wie das Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)-Makro der anderen Datei.
Über SheetChange funktioniert das allerdings nicht...
Verständlich was ich hier meine?
Gruß Boris

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread