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