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 colonne 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) et que les colonnes avant la colonne "testée" jusque la colonne "C" soit cachées de même que les colonnes après la colonne "testée" jusqu'à la colonne "AU" soient aussi cachées.
Voici la macro en question :
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").Select
Selection.EntireColumn.Hidden = False
Range("A4:B4").Select
ActiveCell.FormulaR1C1 = "'HIVER - Semaine 1"
Rows("12:1900").Select
Selection.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 G 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
'G 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").Select
Selection.EntireColumn.Hidden = True
Columns("C:C").Select
Selection.EntireColumn.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 à ceux qui m'aideront,
DRV
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 colonne 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) et que les colonnes avant la colonne "testée" jusque la colonne "C" soit cachées de même que les colonnes après la colonne "testée" jusqu'à la colonne "AU" soient aussi cachées.
Voici la macro en question :
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").Select
Selection.EntireColumn.Hidden = False
Range("A4:B4").Select
ActiveCell.FormulaR1C1 = "'HIVER - Semaine 1"
Rows("12:1900").Select
Selection.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 G 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
'G 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").Select
Selection.EntireColumn.Hidden = True
Columns("C:C").Select
Selection.EntireColumn.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 à ceux qui m'aideront,
DRV
