Zellenamen automatisch aus 2 anderen Zellen halten zusammen setzen

[Kuwer]

Hi,

ThisWorkbook.Names.Add aber sonst im ActiveWorkbook rumeiern  :95:

autsch, wie konnte (mir) das passieren. :22: :19:
Ich biete Dir hier folgendes zur strengen Prüfung: :05:

Sub Namen_Erstellen_3()
  Const SPALTE As Long = 1656 'Hier die Spalte festlegen
  Dim lngR As Long, lngZ As Long
  Dim strNameTeil1 As String, strNameKomplett As String
  Dim strRQ() As Variant
  Dim strRZ() As Variant
  
  strRQ = Array("ä", "Ä", "ö", "Ö", "ü", "Ü", "ß", " ", "'", "(", ")")
  strRZ = Array("ae", "Ae", "oe", "Oe", "ue", "Ue", "ss", "_", "", "", "")
  
  'With ThisWorkbook.Worksheets("Sheet90")
  'oder
  'With ActiveWorkbook.Worksheets("Sheet90")
  'oder
  'With ThisWorkbook.ActiveSheet
  'oder
  With ActiveWorkbook.ActiveSheet
    strNameTeil1 = .Cells(1, SPALTE - 1).Value 'für globalen Namen
    'strNameTeil1 = .Name & "!" & .Cells(1, SPALTE - 1).Value  'für lokalen Namen
    For lngZ = 406 To .Cells(.Rows.Count, SPALTE).End(xlUp).Row
      strNameKomplett = strNameTeil1 & .Cells(lngZ, SPALTE).Value
      For lngR = 0 To UBound(strRQ)
        strNameKomplett = Replace(strNameKomplett, strRQ(lngR), strRZ(lngR))
      Next lngR
      .Parent.Names.Add Name:=strNameKomplett, RefersTo:=.Cells(lngZ, SPALTE)
    Next lngZ
  End With
End Sub

Viele Grüße Uwe