Correction macro

Le
Kyvu
Bonjour,

Cette macro est duplique autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problme c'est la maintenance du code: je dois
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essay de dplacer le code principal dans un
module standard mais a ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernire question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
ii?

Merci pour votre aide.

@micalement.



Kyvu On Line!
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Pascal Engelmajer
Le #1456055
Salut,
il faut chercher soit des modules de classe, soit après avoir exporté le
module de code (.bas)
de l'importer dynamiquement feuille par feuille ( ce qui doit passer par
ActiveWorkbook.VBProject.VBComponents.CodeModule. DeleteLines 1,
ActiveWorkbook.VBProject.VBComponents.CodeModule. CountOfLines
et la ré-écriture ligne par ligne - j'ai jamais essayé, mais on peut
peut-êtr, ActiveWorkbook.VBProject.VBComponents.Import )
--
Amicalement.
Pascal
"il n'y a pas de vent favorable pour celui qui ne sait pas ou il va."
Sénèque.
http://www.ilyapa.net/excel
http://www.ilyapa.net/baseExcel
"Kyvu" news: 1086701c43fdf$6e07d340$
Bonjour,

Cette macro est dupliquée autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problème c'est la maintenance du code: je dois à
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essayé de déplacer le code principal dans un
module standard mais ça ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernière question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
içi?

Merci pour votre aide.

@micalement.



Kyvu On Line!
FxM
Le #1455893
Bonjour,

Il te faut passer les arguments de nom de feuille et de target.
Non testé :

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
sht = activesheet.name

tar = target.address
Call Transfert(sht,tar)
End If
End Sub

Dans mon module standard:

Sub Transfert(sht,tar)
with sheets(sht)

For Each cell In .Intersect(Columns(1), Tar)
If cell <> "" Then
.cell.Offset(, 1) = .Range("B3")
.cell.Offset(, 2) = .Range("C3")
Else
else quoi ???

End If
Next
end with

End sub


@+
FxM

Frédéric Sigonneau
Le #1463941
Bonjour,

Tu pourrais essayer d'utiliser l'événement Workbook_SheetChange du module
ThisWorkbook, exécuté par défaut sur la feuille active lorsqu'elle est modifiée
et, donc, applicable à tout ton classeur (si certaines feuilles doivent être
exclues, il faudra adapter un peu) :

'=============== Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
End If
Next
End If
End Sub
'===============
FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !


Bonjour,

Cette macro est dupliquée autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problème c'est la maintenance du code: je dois à
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essayé de déplacer le code principal dans un
module standard mais ça ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernière question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
içi?

Merci pour votre aide.

@micalement.



Kyvu On Line!


Pascal Engelmajer
Le #1463926
Salut à tous,
avec VBComponents
Sub reInitMesFeuilles()
Dim t
t = Array("feuil2", "feuil5", "feuil5")
For i = 0 To UBound(t)
With Application.VBE.ActiveVBProject.VBComponents(t(i)).CodeModule
.DeleteLines 1, .CountOfLines
.AddFromFile ("feuille.bas") 'contient les procédures
.CodePane.Window.Close
End With
Next i
End Sub

--
Amicalement.
Pascal
"il n'y a pas de vent favorable pour celui qui ne sait pas ou il va."
Sénèque.
http://www.ilyapa.net/excel
http://www.ilyapa.net/baseExcel
"Frédéric Sigonneau" message de news: uVJW4s$
Bonjour,

Tu pourrais essayer d'utiliser l'événement Workbook_SheetChange du module
ThisWorkbook, exécuté par défaut sur la feuille active lorsqu'elle est
modifiée

et, donc, applicable à tout ton classeur (si certaines feuilles doivent
être

exclues, il faudra adapter un peu) :

'=============== > Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)

If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
End If
Next
End If
End Sub
'=============== >
FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !


Bonjour,

Cette macro est dupliquée autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problème c'est la maintenance du code: je dois à
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essayé de déplacer le code principal dans un
module standard mais ça ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernière question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
içi?

Merci pour votre aide.

@micalement.



Kyvu On Line!




Publicité
Poster une réponse
Anonyme