Récupérer toutes les cellules nommées

**sivaaa** · 20/06/2013, 16h35

Bonjour,

J'essaye de développé une macro qui fait 32 choses:
- Copie d'une feuille Devis dans un nouveau fichier = Ca fonctionne
- Création d'une feuille Donnée dans le nouveau fichier = Ca fonctionne
- Copie le nom et la valeur des cellules qui ont un nom défini dans la feuille Donnée du nouveau fichier = Ca ne fonctionne pas.
currentIO.Names me retourne toujours 0 alors que j'ai des cellules avec un nom.

Voici ce que j'ai essayé de faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Sub Sauver()
    Dim currentNewWB As Workbook
    Dim newWB As Workbook
    Dim currentIO As Worksheet
 
    Dim newWSDevis As Worksheet
    Dim newWSDonnee As Worksheet
 
    Dim myName As Name
    Dim intCount As Integer
 
    ' Initialisation avec la feuille existante
    Set currentNewWB = ActiveWorkbook
    ' Initialisation de la feuille In-Outputs
    Set currentIO = currentNewWB.Sheets("In-Outputs")
 
    ' Je copie la feuille courante Devis
    Worksheets("Devis").Copy
 
    Set newWB = ActiveWorkbook
 
    ' Je supprime les formules de la feuille devis
    Set newWSDevis = newWB.Sheets("Devis")
    newWSDevis.UsedRange.Value = newWSDevis.UsedRange.Value
 
    ' Je créé une nouvelle feuille Donnée
    Set newWSDonnee = Sheets.Add(After:=Sheets(Sheets.Count))
    newWSDonnee.Name = "Donnée"
 
    intCount = 0
    For Each myName In currentIO.Names
        newWSDonnee.Range("A" & intCount).Value = myName.Name
        newWSDonnee.Range("A" & intCount).Value = myName.Value
        intCount = intCount + 1
        Next
 
    newWB.SaveAs "d:\NewReport01.xlsx"
    newWB.Close
 
End Sub