Macro qui teste la colonne ou se trouve le bouton ?

**Drvibe** · 21/02/2008, 20h56

Bonjour à tous,

Voici une macro que j'ai créé avec l'aide d'une personne sur un forum.

L'objectif : Quand l'ordinateur détecte un chiffre autre que 0 et autre qu'un texte dans une colonne , la ligne contenant ce chiffre est copiée sur une autre feuille du classeur.

Pour l'instant, cette macro fonctionne parfaitement, mais je dois toujours spécifier la colonne où la vérification doit se faire dans la macro. Et c'est laborieux quand 50 colonnes doivent être testées.

Ce que je voudrais : C'est que l'ordinateur fasse le "check" dans la colonne ou se trouve le bouton (et que je ne doive pas la spécifier dans la macro). Puis que les lignes qui contiennent autre chose que 0 ou du texte soient copiées dans une autre feuille (à partir de la ligne 12) .

Voici la macro en question :

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub trihiver1() 
 
'mot de passe 
Dim Pass As String 
 
Pass = InputBox("Mot de passe requis", "Imprimer le bon de commande", "Saisir le mot de passe ici") 
If Pass <> "print" Then 
Exit Sub 
Else 
Sheets("Bon de commande").Select 
With ActiveSheet.PageSetup 
.CenterHeader = "&""Arial,Gras""&10Commandes Hiver Semaine 1" 
.RightHeader = "&""Arial,Gras""&10Date: " & Format(Date, "d mmm yyyy") 
End With 
Columns("A:AZ").Hidden = False 
Range("A4:B4").FormulaR1C1 = "'HIVER - Semaine 1" 
Rows("12:1900").Clear 
Range("A12").Select 
Dim F_S As Worksheet 'Feuille source 
Dim F_D As Worksheet 'Feuille Destination 
Dim Lig_S As Long 'Ligne source 
Dim Lig_D As Long 'Ligne destination 
 
'MEI ********************************************** 
'Définition des feuilles 
Set F_S = Sheets("Commandes") 'feuille source = onglet(Rex) 
Set F_D = Sheets("Bon de commande") 'feuille destination = onglet(perimee) 
 
'définition des lignes 
'Lig_D = F_D.Range("D1900").End(xlUp).Row + 1 
'Ligne destination est la première de D vide 
Lig_D = 12 
'Programme ***************************************** 
For Lig_S = 12 To F_S.Range("D1900").End(xlUp).Row 
'Pour Ligne source = dernière non vide en G jusqu'à la ligne 1 
'en passant à la ligne précédente par décrémentation (-1) 
'Quand la valeur est inférieure à 1, on passe à laligne suivant Next Lig_S 
If IsNumeric(F_S.Range("D" & Lig_S)) Then 
'évite les erreurs si tu as un titres 
If Int(F_S.Range("D" & Lig_S)) > 0 Then 
'D testé contient une date inférieure à aujourd'hui 
F_S.Rows(Lig_S).Copy 
F_D.Rows(Lig_D).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:= _ 
False, Transpose:=False 
F_D.Rows(Lig_D).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _ 
False, Transpose:=False 
'on copie la ligne source sur la ligne destination 
Lig_D = Lig_D + 1 
'on passe à la ligne destination suivante 
End If 
End If 
Next Lig_S 
'Retour à l'instruction For Lig_S.... 
Columns("E:AU").Hidden = True 
Columns("C:C").Hidden = True 
MsgBox ("Fin de transfert") 
'on avertit que c'est fini 
Reponse = MsgBox("Voules-vous imprimer?", 36, "Demande d'impression") 
If Reponse = 6 Then ActiveSheet.PrintOut Copies:=1 
End If 
 
End Sub

Merci d'avance pour votre aide !