Attribution d'un nom de nombreuses gammes de longueur variable

Question

J'ai une longue liste de valeurs dans une colonne que je veux faire des plages nommées:

• A1010 FONDATIONS STANDARD
• A101001 WALL FONDATIONS
• A101001 COLONNE FONDATIONS & VELOURS CAPS
• A1020 SPECIAL
FONDATIONS
• A102001 FONDATIONS PILE

Lorsque les noms de chaque plage doivent être les cellules en gras.

C'est ce que j'ai jusqu'ici, je suis sûr que c'est maladroit mais c'est le mien (en quelque sorte); Je l'ai bricolé à partir d'autres morceaux de code que j'ai trouvés dans d'autres questions. Il est supposé nommer une gamme avec le texte en gras moins les espaces; puis supprimez à plusieurs reprises la plage nommée et ajoutez-la à nouveau avec chaque nouvelle chaîne non-bold. Quand j'essaye de l'exécuter, j'obtiens l'erreur: Erreur d'exécution 9; indice hors de portée.

Je pense que je suis accroché sur la chose "RefersToR1C1", que j'ai googlé mais cela n'a pas de sens pour moi. J'ai l'impression d'être proche, ce que je pensais il y a quelques heures. Toute aide est appréciée. Je n'en connais que assez pour rompre les choses et perdre mon temps, donc je ne sais rien.

Answer 1

Je l'ai compris. J'ai dû faire une tonne de remplacements dans les noms afin qu'ils puissent être des noms de plage appropriés. Les noms de plage sont en gras et les valeurs ne le sont pas.

Option Explicit 

Sub Change_Name() 

Dim Rng As Range 
Dim cell As String 
Dim RngName As String 
Dim MyADD As Range 
Set MyADD = Nothing 
Sheets("Sheet6").Select 
Range("F1").Activate 

Set Rng = Nothing 

While Not IsEmpty(ActiveCell.Value) 

If ActiveCell.Font.Bold = True Then 

ActiveCell.Replace " ", "" 
ActiveCell.Replace "&", "_" 
ActiveCell.Replace "/", "." 
ActiveCell.Replace "-", "" 
ActiveCell.Replace "(", "_" 
ActiveCell.Replace ")", "_" 
ActiveCell.Replace ",", "_" 
RngName = ActiveCell.Value 
Selection.Offset(1, 0).Select 

    While ActiveCell.Font.Bold = False And IsEmpty(ActiveCell.Value) = False 

     If Rng Is Nothing Then 
      Set Rng = Range(ActiveCell.Address) 
      Selection.Offset(1, 0).Select 
     Else 
      Set MyADD = Range(ActiveCell.Address) 
      Set Rng = Union(Rng, MyADD) 
      Selection.Offset(1, 0).Select 
     End If 
    Wend 

    ActiveWorkbook.Names.Add Name:=RngName, RefersTo:=Rng 
    Set Rng = Nothing 

End If 
    Wend 

End Sub