[XL-2010] utiliser des plages de noms [Résolu]

[tompom3108]

Bonjour à toutes et à tous,

J'essaie de concocter un code pour copier des cellules en utilisant le gestionnaire des noms et évidemment vu que je suis pas une super star ça ne fonctionne pas.
SDV-2011-1129-2 ENT.PORTE Ent.T.P..xls

Dans mon classeur, j'ai créé dans mon gestionnaire des noms deux zones nommées : Zonec = ($A23:$A54)
Zoned = ($C23:$G54)
Les cellules de la zonec appelle un "produit" (d'une autre feuille) sauf pour la valeur 0 ou "", les cellules de la zoned sont à saisir.

Je cherche à archiver (entre autre) les données de la zoned si les cellules correspondantes de la zonec sont <> 0 ou "".

Je mets le semblant de code

Code :

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
42
43
44
45
46
47
48
Sub envoiprod()
 
Num_Fact = Range("F19").Value
            Nom_client = Range("J13").Value
                               Nom_Chantier = Range("H21").Value
    Nb_Pierre = Range("F21").Value
 Dim ran As Range
 Dim Rg As Name
 Dim Rgd As Name
 
Set Rg = ThisWorkbook.Names("Zonec")
Set Rgd = ThisWorkbook.Names("Zoned")
 
For Each cell In Rg
If cell.Value <> 0 Then
Rgd.Select
Activecells.Copy
End If
 
Next
 
Application.Workbooks.Open "f:\TabProd.xlsm"
 
Sheets("Ptour").Activate
 
Range("H3").Select
If Range("H4").Value <> "" Then ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.Paste
 
    Range("A3").Select
If Range("A4").Value <> "" Then ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
 
Do
ActiveCell.Value = Num_Fact
      ActiveCell.Offset(0, 1).Value = Nom_client
      ActiveCell.Offset(0, 2).Value = Indice_Devis
      ActiveCell.Offset(0, 3).Value = Nom_Chantier
      ActiveCell.Offset(0, 4).Value = Nb_Pierre
 
 Range("I3").Select
If Range("I4").Value <> "" Then ActiveCell.End(xlDown).Select
 
Loop Until ActiveCell.End(xlDown) = ""
 
 
End Sub

Pour le moment le débogage m'indique une erreur à ce niveau du code

Code :

1
2
3
4
5
For Each cell In Rg
If cell.Value <> 0 Then
Rgd.Select
Activecells.Copy
End If

Si un doué en VBA pouvait m'aiguiller ce serait super merci d'avance!

[ZebreLoup]

Essaie (faire la même chose pour le reste)

Code :

1
2
Dim Rg As Range
Set Rg = ThisWorkbook.Range("Zonec")

[tompom3108]

Bonjour Zebreloup, merci de m'avoir répondu et excuse moi pour ma réponse tardive.

J'ai essayé ta proposition, mais j'ai un message d'erreur qui dit :
"Membre de méthode ou de données introuvables" sur cette ligne

Code :

Set Rg = ThisWorkbook.Range("Zonec")

Sinon je penser faire une lecture de la colonne A de la cellule $A$23 à $A$54 avec Find et écrire une condition si cell <> 0 ou si "empty" je sais pas trop comment je vais l'écrire encore... alors copie des $C$x:$Gx.

Je ne sais pas si je suis clair enfin y a du boulot.

[ZebreLoup]

Pardon, l'objet Range est soit au niveau de le feuille, soit de l'application. Tu peux faire

Code :

Set rg = Application.Range("Zonec")

Mais si tu as plusieurs classeurs d'ouverts avec éventuellement des noms en doublon tu peux faire

Code :

Set rg = ThisWorkbook.Names("Zonec").RefersToRange

Et attention, dans ce que tu fais pour le moment, chaque fois que tu fais appel à "Copy", ça écrase l'ancienne valeur copiée. C'est l'équivalent d'un Ctrl+c.
Je pense qu'il vaudrait mieux que tu stockes les valeurs dans un tableau ou alors que tu les copies au fur et à mesure. (En utilisant les propriétés Value, plutôt que de faire des copier-coller). Je vais jeter un oeil à ton code plus en détail.

Voici un exemple de code qui pourrait marcher.
(Sous réserve que j'ai bien compris ce que tu voulais faire, ton code n'est pas très clair, attention à l'enregistreur de macro qui t'a mis des .End dans tous les sens)

Code :

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
42
43
44
45
46
Option Explicit
 
Private Const PREMIERE_LIGNE = 23
Private Const DERNIERE_LIGNE = 54
 
Sub envoiprod()
    Dim wsDevis As Worksheet
    Dim wbArchive As Workbook
    Dim wsArchive As Worksheet
 
    Set wsDevis = ThisWorkbook.Worksheets("Devis")
    Set wbArchive = Workbooks.Open("f:\TabProd.xlsm")
    Set wsArchive = wbArchive.Worksheets("Ptour")
 
    Dim premiereLigneVide As Integer
    premiereLigneVide = wsArchive.Cells(wsArchive.Rows.Count, 1).End(xlUp).Row + 1
 
    Dim Num_Fact As String
    Dim Nom_client As String
    Dim Nom_Chantier As String
    Dim Nb_Pierre As Integer
    Dim Reference_Produit As String
 
    Num_Fact = wsDevis.Range("F19").Value
    Nom_client = wsDevis.Range("J13").Value
    Nom_Chantier = wsDevis.Range("H21").Value
    Nb_Pierre = wsDevis.Range("F21").Value
 
    Dim iRow As Integer
 
    For iRow = PREMIERE_LIGNE To DERNIERE_LIGNE
        If wsDevis.Cells(iRow, 1).Value <> 0 Then
            Reference_Produit = wsDevis.Cells(iRow, 3).Value
 
            wsArchive.Cells(premiereLigneVide, 1).Value = Num_Fact
            wsArchive.Cells(premiereLigneVide, 2).Value = Nom_client
            'wsArchive.Cells(premiereLigneVide, 3).Value = Indice_Devis 'Je ne sais pas ce que c'est
            wsArchive.Cells(premiereLigneVide, 4).Value = Nom_Chantier
            wsArchive.Cells(premiereLigneVide, 5).Value = Nb_Pierre
 
            wsArchive.Cells(premiereLigneVide, 8).Value = Reference_Produit
 
            premiereLigneVide = premiereLigneVide + 1
        End If
    Next iRow
End Sub

[tompom3108]

Salut Zebreloup excuse moi pour ma réponse encore tardive.
Ton code marche super bien, c'est exactement ce que je cherchais à faire

Evidemment avec 1 mois en loisir de VBA c'est sur que mes codes sont un peu empirique en tout cas je te remercie Bp à la prochaine