verification code

Bonjour Marion, le Forum,

Petit à petit l'oiseau fait son nid. Dit on

Je vais regarder, Baside

Rebonjour,

Il y a beaucoup de lignes select et il ne faut pas oublier qu'à chaque point, Excel marque une pause de réflexion.
Pourquoi ne pas mettre le fichier, ce serait plus simple.

Baside

Bonjour a toi baside.


Le fichier est important, je ne peux pas vous l'envoyer.

mais pouquoi avec un bouton le résultat est immédiat et des que je désire l'activer a l'ouverture de la feuille ho la la.

A+Marion

merci de ta réponse quand même.

Salut Marion,

En l'absence de fichier, je ne peux que te proposer des pistes sans pouvoir les tester.
Néanmoins, pour commencer, je pense que l'utilisation de l'évennement 'Worksheet_Activate()' n'est pas le plus adapté à ton code. En fait, ça dépend de la feuille où tu as placé ce code.
Si c'est dans une des feuilles que tu utilise dans ton code ('planning', ou 'besion en matière'), ça risque de mal marcher.
Je te propose donc d'envisager Workbook_Open qui se déclenchera à chaque ouverture du classeur.

En outre, je te propose quelques changements, qui devraient accélérer ta procédure. De plus, tes feuilles sont déclarées en début de macro, à un endroit unique, ce qui facilite la maintenance et la modification.


Private Sub Workbook_Open()
Dim nbMatieres As Integer, cpt1 As Integer
Application.ScreenUpdating = False

Set org = Sheets('planning')
Set dest = Sheets('besion en matiere')

nbMatieres = org.Range('IV84').End(xlToLeft).Column
dest.Range('a4:c47').ClearContents

For cpt1 = 38 To nbMatieres
If org.Cells(84, cpt1) > 0 Then
org.Cells(84, cpt1).Copy
dest.Range('c65536').End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(3, cpt1).Copy
dest.Range('b65536').End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(2, cpt1).Copy
dest.Range('a65536').End(xlUp)(2).PasteSpecial Paste:=xlValues
End If
Next cpt1

Application.CutCopyMode = False
'Application.ScreenUpdating = True
dest.Select
'Range('a1').Select
End Sub


A te lire à ce sujet.

bonsoir Rai .

j'ai une macro que j'ai nommée comptage (module1)

elle recupère les matieres de la feuille planning et les colle sur la feuille besion matiere.

un bouton quelquonque déclanche la macro RAS

lorsque je la met sur la feuille besion matiere, comme tu dit ça na se passe pas bien du tout.

J'ai essayé de mettre un Msgbox a l'ouverture de la feuille en posant la question oui ou non mais si je clique sur oui il reapparaît tout le temps.

l'idée de mette çà a l'ouverture du classeur ne pourra pas foctionner car j'ai besoin de naviguer sur les feuilles et elles doivent être actualiser, je ne peutxpas ouvrir et fermer le classeur.


Merci quand même

A+Marion

re-,

J'ai pas tout suivi :
- tu veux utiliser cette macro sur appui de bouton
ou
- à la sélection de la feuille 'besion en matiere' la macro doit se déclencher automatiquement ??

Quoiqu'il en soit, avec les modifs ci-dessous, ça devrait passer sur activation de la feuille :

Private Sub Worksheet_Activate()
Dim nbMatieres As Integer, cpt1 As Integer
Application.ScreenUpdating = False

Set org = Sheets('planning')
Set dest = Sheets('besion en matiere')

nbMatieres = org.Range('IV84').End(xlToLeft).Column
dest.Range('a4:c47').ClearContents

For cpt1 = 38 To nbMatieres
If org.Cells(84, cpt1) > 0 Then
org.Cells(84, cpt1).Copy
dest.Range('c65536').End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(3, cpt1).Copy
dest.Range('b65536').End(xlUp)(2).PasteSpecial Paste:=xlValues

org.Cells(2, cpt1).Copy
dest.Range('a65536').End(xlUp)(2).PasteSpecial Paste:=xlValues
End If
Next cpt1

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Bye

Re-, Re- salut

Je viens de relire ton code avec un tout petit plus d'attention, et te propose une simplification :

Private Sub Worksheet_Activate()
Dim nbMatieres As Integer, cpt1 As Integer
Application.ScreenUpdating = False

Set org = Sheets('planning')
Set dest = Sheets('besion en matiere')

nbMatieres = org.Range('IV84').End(xlToLeft).Column
dest.Range('a4:c47').ClearContents

For cpt1 = 38 To nbMatieres
If org.Cells(84, cpt1) > 0 Then
dest.Range('c65536').End(xlUp)(2) = org.Cells(84, cpt1)
dest.Range('b65536').End(xlUp)(2) = org.Cells(3, cpt1)
dest.Range('a65536').End(xlUp)(2) = org.Cells(2, cpt1)
End If
Next cpt1

Application.ScreenUpdating = True
End Sub

Bonne soirée

Super de chez super.

un grand merci Rai..

je l'ai mis dans la feuille besion en matiere et çà fonctionne.


Le VBA m'en fait voir, mais ses tèllement passionnant.


gros bisous

A+Marion