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 codePour le moment le débogage m'indique une erreur à ce niveau du code
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
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
Si un doué en VBA pouvait m'aiguiller ce serait super merci d'avance!
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 For Each cell In Rg If cell.Value <> 0 Then Rgd.Select Activecells.Copy End If
Partager