Comment automatiser l'exécution d'un code macro

Le 09/10/2011 à 16:43

Salut à tous

je lance un coucou à tous les membres de ce forum.

Merci pour tout ce que vous faites et ferai pour la bonne cause du forum.

J'ai un petit soucis avec une macro.

En effet, je souhaiterai qu'on automatise l'exécution de la macro ci-dessous:

Sub copier()

Dim fin&, cel As Range, cel1 As Range, cel2 As Range, cel3 As Range, cel4 As Range

Set cel = Feuil11.Range("F:F").Find(Feuil1.Range("F20"))

Set cel1 = Feuil11.Range("C:C").Find(Feuil1.Range("B41"))

Set cel2 = Feuil11.Range("D:D").Find(Feuil1.Range("B5"))

Set cel3 = Feuil11.Range("E:E").Find(Feuil1.Range("B17"))

Set cel4 = Feuil11.Range("F:F").Find(Feuil1.Range("E9"))

If cel Is Nothing Then

If cel1 Is Nothing Then

If cel2 Is Nothing Then

If cel3 Is Nothing Then

If cel4 Is Nothing Then

With Feuil1

If .Range("E9") <> "" Then

fin = Feuil11.Range("B" & Rows.Count).End(xlUp).Row + 1

Feuil11.Cells(fin, 2) = .Range("F20")

Feuil11.Cells(fin, 3) = .Range("B41")

Feuil11.Cells(fin, 4) = .Range("B5")

Feuil11.Cells(fin, 5) = .Range("B17")

Feuil11.Cells(fin, 6) = .Range("E9")

End If

End With

End If

End If

End If

End If

End If

End Sub

Je suis obliger d'executer la macro manuellement.

Je souhaite que son exécution soit automatisée. je ne veut pas passer par un bouton ni par une touche de raccourci pour que ma macro se s'exécute.

j'espère m'avoir bien fais comprendre sinon je reste à votre disposition pour les cas d'éclaircissements.

Le 09/10/2011 à 17:13

Bonjour Zombe le forum

Bon alors un fichier est plus parlant que des explications imprécises !!!!!!

tu veux quoi? ta macro actuelle est ou dans une feuille ou dans un module ?

Tu veux activer la macro sur quel action? une ouverture de feuille ? un changement de sélection de cellule ?

En clair des explications STP ou un fichier avec des explications et on te fait cela par retour

a+

Papou

Le 09/10/2011 à 17:18

Bonjour

Bonjour Paritec

Ne connaissant pas le contexte ce n'est qu'une proposition

Code à mettre dans la code de la Feuil1

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fin&, cel As Range, cel1 As Range, cel2 As Range, cel3 As Range, cel4 As Range

  If Not Intersect(Range("B5,B17,B41,E9,F20"), Target) Is Nothing And Target.Count = 1 Then
    If Application.CountA(Feuil1.Range("B5,B17,B41,E9,F20")) = 5 Then
      Set cel = Feuil11.Range("F:F").Find(Feuil1.Range("F20"))
      Set cel1 = Feuil11.Range("C:C").Find(Feuil1.Range("B41"))
      Set cel2 = Feuil11.Range("D:D").Find(Feuil1.Range("B5"))
      Set cel3 = Feuil11.Range("E:E").Find(Feuil1.Range("B17"))
      Set cel4 = Feuil11.Range("F:F").Find(Feuil1.Range("E9"))
      If cel Is Nothing Then
        If cel1 Is Nothing Then
          If cel2 Is Nothing Then
            If cel3 Is Nothing Then
              If cel4 Is Nothing Then
                With Feuil1
                  If .Range("E9") <> "" Then
                    fin = Feuil11.Range("B" & Rows.Count).End(xlUp).Row + 1
                    Feuil11.Cells(fin, 2) = .Range("F20")
                    Feuil11.Cells(fin, 3) = .Range("B41")
                    Feuil11.Cells(fin, 4) = .Range("B5")
                    Feuil11.Cells(fin, 5) = .Range("B17")
                    Feuil11.Cells(fin, 6) = .Range("E9")
                  End If
                End With
              End If
            End If
          End If
        End If
      End If
    End If
  End If
End Sub

Si pas ça

Le 10/10/2011 à 00:37

Salut Paritec

Merci pour le feedback et la proposition.

La macro est dans une feuille.

Elle devra s'exécuter après que la cellule B41 ait été renseignée.

Si mes explications ne sont toujours pas claires, je vous serai reconnaissant de me revenir encore.

Bonne compréhension

Le 10/10/2011 à 15:52

Salut à tous les amis du forum

Permettez-moi d'apporter certaines précisions sur la macro à transformer.

Je me suis rendu compte quelle a des insuffisances.

En effet, elle ne prend pas en compte les doublons.

Pourtant il peut y avoir des doublons sur toutes les autres colonnes mais pas de doublons sur la colonne C c'es à dire que 2 personnes ne peuvent pas avoir le meme n° de compte.

Aussi, lorsqu'il y'a du vide dans les cellules à copier, la macro ne doit pas s'exécuter. En rappel, voici les cellules à copier : B5, B17,B41, F20 et E9. A chaque fois qu'il y'a des valeurs dans les cellules listées, la macro doit s'exécuter.

La macro commence à s'exécuter après avoir renseigné la cellule B41.

Merci de m'aider même s'il faudra revoir toute la macro.

Vos propositions seront les bienvenues.

Le 10/10/2011 à 17:03

Bonjour à tous,

On ne contrôle donc que les doublons en colonne "C"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg&, c As Range, Plg As Range
  If Not Application.Intersect(Target, Range("b41")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub

    Set Plg = Union(Range("f20"), Range("b41"), Range("b5"), Range("b17"), Range("e9"))
    If Application.CountA(Plg) < 5 Then MsgBox ("incomplet !"): Exit Sub

    With Sheets("Feuil11")
        Lg = .Range("b" & Rows.Count).End(xlUp).Row + 1

        Set c = .Range("c2:c" & Lg).Find(Target, LookIn:=xlValues)
        If c Is Nothing Then
            .Cells(Lg, 2) = Range("F20")
            .Cells(Lg, 3) = Range("B41")
            .Cells(Lg, 4) = Range("B5")
            .Cells(Lg, 5) = Range("B17")
            .Cells(Lg, 6) = Range("E9")
            .Activate
        Else
            Target.Activate
            MsgBox (Target & "  existe déjà en  " & c.Address)
            Application.Goto .Range("a1"), Scroll:=True
            .Range(c.Address).Activate
        End If
    End With
        'Plg.ClearContents       'efface données
  End If
End Sub

si pas çà, joins un fichier anonymisé

Amicalement

Claude

19zombe-macro-1.zip (14.89 Ko)
Le 10/10/2011 à 17:22

Bonsoir Zombe, à tous,

bon bah je vois que tu as eu ta réponse alors à plus

a+

Papou

Le 11/10/2011 à 15:33

Bonjour

Merci pour le code proposé.

J'ai essayé la macro avec mon fichier joint mai elle ne fonctionne pas comme souhaité.

Je vous envoie mon fichier afin que vous puissiez voire ce qui ne va pas.

N.B:mon fichier a été modifié (suppression de certaines feuilles) donc les feuilles de votre macro sont à modifiés.

Pouvez-vous tester jusqu'à 5 cas et voir que les copier-coller vers la feuille "MANK" se réalise?

Bonne compréhension

13essai-zombe2.zip (15.62 Ko)
Le 11/10/2011 à 18:07

Bonsoir,

Quelles sont les cellules à copier ?

mets un exemple en feuille "MANK"

C'est "B42" qui doit être unique ?

Bref, précise un peu ta demande !

à te relire

Claude

Le 12/10/2011 à 15:24

Bonsoir Dubois et à tous les membres du forum

Ci-joint le fichier sur la base duquel la macro devra être réalisée.

Sur la feuille DONNE, les cellules à copier sont celles colorées. Il y'a au total 5.

La copie doit se réalisée si toutes les 5 cellunes ne sont pas vides.

La macro doit s'exécuter après la saisie sur la cellule B41 de la feuille DONNE.

Sur la feuille MANK, vous pourrez âpprécier le résultat des collages.

Merci de me revenirsur toute renseignement pouvant vous aider à réaliser une macro qui répond à mes attentes.

Bonne compréhension

19zombe-exemple.zip (13.55 Ko)
Le 12/10/2011 à 16:00

Bonjour

A tester

9zombe-recopie-v001.zip (22.85 Ko)
Le 12/10/2011 à 18:12

Bonsoir à tous,

Macro adaptée à ton dernier fichier

elle se déclenche en remplissant "DONNE B42"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg&, c As Range, Plg As Range
  If Not Application.Intersect(Target, Range("b42")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub

    Set Plg = Union(Range("f20"), Range("b42"), Range("b5"), Range("b17"), Range("e13"))
    If Application.CountA(Plg) < 5 Then MsgBox ("incomplet !"): Exit Sub

    With Sheets("MANK")
        Lg = .Range("b" & Rows.Count).End(xlUp).Row + 1

        Set c = .Range("c2:c" & Lg).Find(Target, LookIn:=xlValues)
        If c Is Nothing Then
            .Cells(Lg, 2) = Range("F20")    'date
            .Cells(Lg, 3) = Range("B42")    'N°compte
            .Cells(Lg, 4) = Range("B5")     'nom
            .Cells(Lg, 5) = Range("B17")    'Tel
            .Cells(Lg, 6) = Range("E13")    'document
            .Activate
        Else
            Target.Activate
            MsgBox (Target & "  existe déjà en  " & c.Address)
            Application.Goto .Range("a1"), Scroll:=True
            .Range(c.Address).Activate
        End If
    End With
        'Plg.ClearContents       'efface données
  End If

Amicalement

Claude

12zombe-macro-2.zip (23.71 Ko)
Le 13/10/2011 à 15:25

Bonsoir à tous

Merci pour vos propositions.

Après plusieur tests, je viens vous presenter mes observations :

Les 2 macros que vous avez proposée(BANZAI64 et DUBOIS) fonctionnent mais pas dans tous les cas.

Lorsuqe les 5 cellules ne sont pas vides le fonctionnement de la macro est bonne.

Mais lorsque parmi les 5 cellules il y'a du vide c'est à dire que ces cellules ne contiennent pas de valeur (ce que vous pourrez constater avec le fichier joint) la macro continue de copier ; ce qui n'est pas nomal.

IL doit y avoir copie que lorsque les 5 cellules ne sont pas vides. Autrement dit, la macro ne doit s'exécuter que si toutes les 5 cellules à copier ne sont pas vides.

Autre observations chez Dubois :

J'ai remarqué qu'après exécution de la macro, le curseur se positionne sur la feuille MANK.

Je ne veux pas cela. je veux qu'il reste sur la cellule suivante (B43).

N.B : dans la pièce-jointe, vous verrez en rouge ce qui ne devrait pas être copié.

Merci de revoir ce que vous pouvez faire pour moi en tenant compte de mes observations.

Vous allez y arrivé, j'en suis convaincu.

7zombe-exemple-revise.xlsm (86.88 Ko)
Le 13/10/2011 à 20:33

Bonsoir,

IL doit y avoir copie que lorsque les 5 cellules ne sont pas vides. Autrement dit, la macro ne doit s'exécuter que si toutes les 5 cellules à copier ne sont pas vides.

La macro faisait çà, seulement dans ton fichier joint, F20 et E13 ne sont pas vides, il y avait des espaces parasites !

Nouveau code

Public Flag As Boolean ' (dans Module si autres macros)

Private Sub Worksheet_Change(ByVal Target As Range)
If Flag Then Exit Sub
Dim Lg&, c As Range, Cel
  If Not Application.Intersect(Target, Range("b42")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub

    Flag = True

    For Each Cel In Array("b5", "b17", "b42", "e13", "f20")
        With Range(Cel)
            .Value = Trim(.Value)           'supprime espaces début/fin
            If IsEmpty(.Value) Then
                .Activate
                MsgBox ("Champ  " & ActiveCell.Address & "  Obligatoire")
                Flag = False: Exit Sub
            End If
        End With
    Next Cel

    With Sheets("MANK")
        Lg = .Range("b" & Rows.Count).End(xlUp).Row + 1

        Set c = .Range("c2:c" & Lg).Find(Target, LookIn:=xlValues)
        If c Is Nothing Then
            .Cells(Lg, 2) = Range("F20")    'date
            .Cells(Lg, 3) = Range("B42")    'N°compte
            .Cells(Lg, 4) = Range("B5")     'nom
            .Cells(Lg, 5) = Range("B17")    'Tel
            .Cells(Lg, 6) = Range("E13")    'document
        Else
            Target.Activate
            MsgBox (Target & "  existe déjà en  " & c.Address)
            'Application.Goto .Range("a1"), Scroll:=True
            '.Range(c.Address).Activate
        End If
    End With

        'Range("b5,b17,b42,e13,f20").ClearContents 'efface données
  End If
Flag = False
End Sub

Claude

7zombe-macro-3.zip (24.84 Ko)
Le 14/10/2011 à 23:29

Bonsoir Dubois

Merci pour cette merveilleuse macro.

dubois a écrit :

La macro faisait çà, seulement dans ton fichier joint, F20 et E13 ne sont pas vides, il y avait des espaces parasites !

Comment gerer ces espaces parasites?

J'ai remarqué que lorsqu'il y'a une cellule vide parmi les 5 à copier, il y'a un msgbox qui s'affiche :"Champ .... obligatoire".

Serait'il possible que rien ne s'affiche sans que cela ne joue sur la qualité de la macro.

le Msgbox risque de perturber mes utilisateurs.

Aussi, j'ai déjà une macro sur la feuil1. En utilisant les modules je m'ensors pas.

En collant la macro sur un module, la macro ne fonctionne pas comme souhaitée.

Pouvez-vous revoir cela. si possible avec un exemple du fichier que vous avez joint.

Que DIEU te bénisse.

Le 15/10/2011 à 10:51

Bonjour,

Comment gerer ces espaces parasites?

ici, la macro s'en charge

        With Range(Cel)
            .Value = Trim(.Value)           'supprime espaces début/fin

le Msgbox risque de perturber mes utilisateurs.

il faut bien prévenir qu'il manque l'information ! (tu peux supprimer cette ligne de code)

MsgBox ("Champ Obligatoire")

En collant la macro sur un module, la macro ne fonctionne pas comme souhaitée.

La macro Private Sub Worksheet_Change(ByVal Target As Range) doit être dans

le VBE de la feuille "DONNE" et non dans un module.

On tourne en rond là ! , si tu n'arrive pas à adapter,

il faudrait voir le fichier réel avec ses macros,

utilise ce lien http://www.cjoint.com

Voici ton dernier fichier adapté

à te relire

Claude

10zombe-macro-4.xlsm (90.02 Ko)
Le 15/10/2011 à 20:16

Salut Dubois

Ci-joint mon fichier réel pour adaptation.

Elle contient le code de la macro que tu m’as envoyé.

Je ne sais pas pourquoi mais elle ne fonctionne pas comme je veux.

Peux-tu voire ce qui cloche ? Aussi, j’ai remarqué que quand une des cellules à copier est vide, le curseur se positionne sur la dite cellule. Je ne souhaite pas cela ; peux-tu revoir ca également ?

L’unique condition que je veux est que quand les 5 cellules citées (B5, B17, B41, E13 et F20) ne sont pas vides, qu’il y’ait copie. Les signalisations sur les cellules vides ne m’interesse pas trop.

Ci-dessous le code de la macro qui était sur la feuille DONNE.

Est-ce possible de loger(voir fusionner) les deux macros sans qu’il y’ait de conflit entre elles tout en obtenant les résultat de chacune?

Sinon comment faire avec mes deux macros qui doivent pourtant fonctionner?

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo fin

If Range("B4").Value = "CH PARTICULIER" Then

If Target.Address = "$B$34" And Target.Value <> "" Then

Range("B36").Select

ElseIf Target.Address = "$B$37" And Target.Value <> "" Then

Range("B41").Select

ElseIf Target.Address = "$B$42" And Target.Value <> "" Then

Call colorer_cellule

Range("E3").Select

Else: GoTo fin

End If

ElseIf Range("B4").Value = "CL" Then

If Target.Address = "$B$18" And Target.Value <> "" Then

Range("B21").Select

ElseIf Target.Address = "$B$34" And Target.Value <> "" Then

Range("B36").Select

ElseIf Target.Address = "$B$37" And Target.Value <> "" Then

Range("B41").Select

ElseIf Target.Address = "$B$42" And Target.Value <> "" Then

Call colorer_cellule

Range("E3").Select

Else: GoTo fin

End If

Else: GoTo fin

End If

fin:

Exit Sub

End Sub

Sub colorer_cellule()

Dim cpt As Integer

'

' Macro1 Macro

' Macro enregistrée le 30/09/2011 par Sebastien

'

'

Range("B5").Select

cpt = 0

Do While cpt < 46 'permet de tester de B5 à B50

If ActiveCell.Value = "" Then

With Selection.Interior

.ColorIndex = 15

.Pattern = xlSolid

End With

ActiveCell.Offset(1, 0).Select

cpt = cpt + 1

Else

ActiveCell.Offset(1, 0).Select

cpt = cpt + 1

End If

Loop

End Sub

Peux-tu voir si c’est possible de logé(fusionner) les deux macros sans créer des conflits entre elles ?

Le 15/10/2011 à 23:46

Bonsoir,

On écrit pas des macros évènementielles comme tu l'avait fait,

j'ai refondu l'ensemble d'après ce que j'ai cru comprendre.

J'ai refait la macro colorer (Module 1)

tu aurais pu laisser la macro "Effacer", pour voir !

Le Module 2 est à supprimer (c'est une copie de ton ancien Private Sub)

Claude

10zombe-macro-v5.zip (64.86 Ko)
Le 17/10/2011 à 04:40

Bonsoir Dubois

Merci pour votre proposition de fusion des deux macros.

Desolé mais ca ne fonctionne pas comme je veux.

La macro copier-coller fonctionne bien avec la fusion mais

l'autre macro dont l'objet est de gérer l'ordre de passage du curseur dans la plage B5:B50

ne fonctionne pas.

Ci-dessous la macro qui avait permi à Sébastien de réaliser la macro : ORDRE DE PASSAGE DU CURSEUR

A la lecture de ce message, cela vous permettra de comprendre la macro qui a été consu à cet effet, ce qui vous aidera de reussir une bonne fusion.

Je cherche à automatiser l'ordre de passage du curseur dans une plage.

En effet, je saisie des données dans la plage B5:B50.

En fonction de la valeur que prendra la cellule B4, certaines cellules ne doivent pas être renseignées(facultatif).

J'aimerai avoir une macro dont l'objet est de gérer l'ordre de passage d'une cellule à une autre suivants les critères ci-dessous:

1) si la valeur de la cellule B4 =CH PARTICULIER voici la réalisation attendue:

  • je souhaite qu'après la cellule B34 le curseur se positionne en B36,
  • de même, après avoir B37 que le curseur se positionne en B41,
  • Enfin, après la cellule B42 que le curseur se positionne sur le bouton de la macro IMPRIMER.

2) si la valeur de la cellule B4 =CL voici la réalisation attendue:

  • je souhaite qu'après la cellule B18 le curseur se positionne en B21,
  • de même, après avoir B34 que le curseur se positionne en B36,
  • ensuite, après B37, que le curseur se positionne en B41,
  • Enfin, après la cellule B42 que le curseur se positionne sur le bouton de la macro IMPRIMER.
N.B : * Pour les autres valeurs de la cellule B4 toute la plage doit être accessible,

* si possible egalement, que les cellules inactives c'est à dire n'ayant pas été renseignées soient grisées après la saisie de la dernière cellule.

Je reste à votre disposition pour de plus amples explications.

Bonne compréhension

Le 17/10/2011 à 10:27

Bonjour à tous,

J'ai plus la patience !

quand c'est tordu au départ, c'est bien tordu !!

Je laisse la place à qui voudra prendre la suite,

désolé !

Claude

Rechercher des sujets similaires à "comment automatiser execution code macro"