Incrémentation d'une action " boucle VBA"

Bonjour à tous,

Je suis actuellement coincée avec mon codes Vba qui me renvoie une erreur " procédure trop longue"

Du coup étant nouveau dans le monde Vba je me tourne vers vous afin de m'aider à trouver une solution de boucle si cela est possible.

Je souhaiterais sur le code ci-dessous incrémenter le N° de ligne en "AB5;6;7;..." et le n° des action "1;2;3;... via une boucle pour éviter cette erreur de procédure trop longue.

Merci par avance pour votre aide.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Sheets("info").Range("AB5")) Is Nothing Then

Call Action1

MsgBox "Calcul PPM ET CELLULES AUTO OK"

End If

If Not Intersect(Target, Sheets("info").Range("AB6")) Is Nothing Then

Call Action2

MsgBox "Calcul PPM ET CELLULES AUTO OK"

End If

If Not Intersect(Target, Sheets("info").Range("AB7")) Is Nothing Then

Call Action3

……………………………………………. Etc.

MsgBox "Calcul PPM ET CELLULES AUTO OK"

End If

If Not Intersect(Target, Sheets("info").Range("AB600")) Is Nothing Then

Call Action597

MsgBox "Calcul PPM ET CELLULES AUTO OK"

End If

Bonjour,

Et si tu nous en disais un peu plus ? Notamment :

• A quoi sert ton fichier ?
• Que cherches tu a faire en macro ?
• Que contiennent les macros "ActionXXX" ?

L'idéal étant bien sur de joindre un fichier pour mieux illustrer tout ça...

Bonjour Pedro,

Merci pour ta réactivité.

Ce fichier sert à la gestion des non-conformités est au transfert de données vers un autres fichier.

Après avoir perdu beaucoup de neurone à faire ce fichier je devais donc dupliquer mes macros sur minimum 500 lignes et là cette erreur et survenu. " Du coup un peu déçu car cela fonctionner très bien"

Voila le code dans action...

Sub Action1()

' Action1 Macro

' Transfert valeurs PPM auto apres saisie cellules AB " via macro feuil2 info"

Range("DY5").Select

Selection.Copy

Range("AQ5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

' Transfert valeurs N° fournisseur auto apres saisie cellules AB

Range("DQ5").Select

Selection.Copy

Range("J5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

' Transfert valeurs Adresse fournisseur auto apres saisie cellules AB

Range("DR5").Select

Selection.Copy

Range("K5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

' Transfert valeurs désign article auto apres saisie cellules AB

Range("DS5").Select

Selection.Copy

Range("M5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

' Transfert valeurs Plan auto apres saisie cellules AB

Range("DT5").Select

Selection.Copy

Range("O5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

' Remplissage cellules avec NA auto apres saisie cellules AB

Range("DZ5:EM5").Select

Selection.Copy

Range("AC5:AP5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("EN5:FB5").Select

Selection.Copy

Range("AR5:BF5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End Sub

Concernant mon fichier est il possible de vous l'envoyer autrement que par ce forum car assez confidentiel.

Encore merci pour votre prise en compte

Quelques remarques :

• Fichier confidentiel : on n'a pas besoin de l'original, mais un fichier fictif qui en reprend la structure
• Poster du code dans un message : utiliser les balises pour la mise en forme (bouton </>)
• Concernant le code :

ça c'est ce que donnerai l'enregistreur...

Range("DQ5").Select
Selection.Copy
Range("J5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Voilà une version simplifiée (et moins gourmande...) :

Range("J5") = Range("DQ5")

Merci pour ces infos.

Mon fichier étant trop volumineux je ne peux vous le joindre.

Malheureusement cela ne résout pas mon soucis car l'erreur de procédure trop longue se trouve sur la page info avec ce code ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Sheets("info").Range("AB5")) Is Nothing Then
Call Action1
MsgBox "Calcul PPM ET CELLULES AUTO OK"
End If
If Not Intersect(Target, Sheets("info").Range("AB6")) Is Nothing Then
Call Action2
MsgBox "Calcul PPM ET CELLULES AUTO OK"
End If
If Not Intersect(Target, Sheets("info").Range("AB7")) Is Nothing Then
Call Action3
……………………………………………. Etc.

MsgBox "Calcul PPM ET CELLULES AUTO OK"
End If
If Not Intersect(Target, Sheets("info").Range("AB600")) Is Nothing Then
Call Action597
MsgBox "Calcul PPM ET CELLULES AUTO OK"
End If

Ton code étant entièrement dépendant de la structure même de ton fichier, je ne saurais t'aider sans...

Aussi, plutôt que de répéter inutilement des actions similaires, tu peux t'aider d'une boucle...

Par exemple :

For i = 5 To 1000
   If IsEmpty(Range("AB" & i)) Then Range("AB" & i) = Range("AC" & i)
Next i

Voilà le fichier avec une ligne de pilotage afin de pouvoir te le partager. Il y a des infos de fonctionnement dans un onglet.

Merci pour cette boucle mais vu que le remplissage d'une cellule pilote le lancement de mon action 1 cela ne fonctionne pas.

Encore merci pour le temps que tu consacre à mon problème.

Tritium54 a écrit :

Voilà le fichier avec une ligne de pilotage afin de pouvoir te le partager. Il y a des infos de fonctionnement dans un onglet.

Merci pour cette boucle mais vu que le remplissage d'une cellule pilote le lancement de mon action 1 cela ne fonctionne pas.

Encore merci pour le temps que tu consacre à mon problème.

Et pourquoi ça ne fonctionnerais pas ? On peut aussi bien écrire :

For i = 5 To DerLigne
   If Not Intersect(Target, Sheets("info").Range("AB" & i)) Is Nothing Then 
        'Instructions
        MsgBox "Calcul PPM ET CELLULES AUTO OK"
   End If
Next i

Merci je vais essayer cela est je vous ferais un retour, dernière interrogation,

Que signifie 'Instructions dans votre ligne de code?

Tritium54 a écrit :

Merci je vais essayer cela est je vous ferais un retour, dernière interrogation,

Que signifie 'Instructions dans votre ligne de code?

Rien, c'est un commentaire pour signifier que c'est là que tu peux réaliser (directement) une série d'instructions (plutôt que d'appeler une macro dédiée).

Ok, c'est bien ce que je pensée, du coup je ne vois pas comment intégré toutes ces instructions du module 3 car là aussi je pilote par ligne donc ça va être énorme jusqu’à la ligne 500.

Pas évident la programmation vba mais je ne lâcherai pas est très intéressant.

Ok, c'est bien ce que je pensée, du coup je ne vois pas comment intégré toutes ces instructions du module 3 car là aussi je pilote par ligne donc ça va être énorme jusqu’à la ligne 500.

Pas évident la programmation vba mais je ne lâcherai pas est très intéressant.

Bonjour Pedro,

De retour après quelques essais, j'avance sur le sujet mais je n'arrive pas à comprendre comment effectuer cette procédure sans devoirs la recopier pour chaque ligne de ma feuille au risque d'avoir encore une fois trop de lignes de programme.

Est-il possible d'utiliser ce code pour piloter chaque ligne indépendamment ou faut ‘il écrire ce code autant de fois qu'il me faut de ligne ?

Merci par avance pour votre retour.

Private Sub Worksheet_Change(ByVal Target As Range)

   If Not Application.Intersect(Target, Sheets("info").Range("AB5:AB500")) Is Nothing Then
        'Instructions
        ' Action1 Macro

For I = 5 To 5
     Range("AQ" & I) = Range("DY" & I)
   Next
Dim plage As Range
  Set plage = Union(Range("AC5:AP5"), Range("AR5:BF5"))
  plage.Value = "NA"

        MsgBox "Calcul PPM ET CELLULES AUTO OK"
   End If

End Sub

Tritium54 a écrit :

Bonjour Pedro,

De retour après quelques essais, j'avance sur le sujet mais je n'arrive pas à comprendre comment effectuer cette procédure sans devoirs la recopier pour chaque ligne de ma feuille au risque d'avoir encore une fois trop de lignes de programme.

Est-il possible d'utiliser ce code pour piloter chaque ligne indépendamment ou faut ‘il écrire ce code autant de fois qu'il me faut de ligne ?

Merci par avance pour votre retour.

Private Sub Worksheet_Change(ByVal Target As Range)

   If Not Application.Intersect(Target, Sheets("info").Range("AB5:AB500")) Is Nothing Then
        'Instructions
        ' Action1 Macro

For I = 5 To 5
     Range("AQ" & I) = Range("DY" & I)
   Next
Dim plage As Range
  Set plage = Union(Range("AC5:AP5"), Range("AR5:BF5"))
  plage.Value = "NA"

        MsgBox "Calcul PPM ET CELLULES AUTO OK"
   End If

End Sub

Bonjour,

Je n'ai pas ton fichier avec les codes sous les yeux et je ne comprend pas bien ce que tu dois faire TRÈS EXACTEMENT. Ce qui est certain, c'est que tu peux faire un code général plutôt que de répéter des actions quasi-identiques à des endroits différents.

Autre remarque : as-tu conscience qu'il n'y a aucun intérêt à écrire : For I = 5 To 5 ? (littéralement : "pour I allant de 5 à 5")

Je vous renvoie mon fichier.

Le but exact est :

J'aimerais que dès qu’une cellule de la colonne AB de mon onglet info et remplie renvoyer des info se trouvant sur des colonnes plus loin de cette même feuille vers mon tableau. Et cela sur toutes les ligne de mon tableau.

Ex:

Remplissage cellules AB5 copie cellules DY5 et colles sur cellules AQ5;.........etc.

Je dois effectuer cela car dans un 2eme temps j'extrais les infos de la dernière ligne de ce tableau vers un autre fichiers avec end xlup donc je ne peux pas avoir de formule ou de cellules non renseigner sur ce tableau.

Pour info d'autre info se trouve dans l'onglet "but et utilisation fichiers".

Avez vous compris mon problème?

Tritium54 a écrit :

Avez vous compris mon problème?

Je n'ai pas eu le temps d'y regarder, un peu de patience.

Aucun souci.