macro vs macro

[invite149ad00e]

Bonjour À tous
J'ai un problème avec deux macros lorsque je lance une macro celle-ci écrase la première
je m'explique j'ai un fichier excel avec plusieurs feuilles 7 dont 6 on une macro et 1 une autre macro
lors que je sélection des éléments sur une feuille le tout se transfert sur la feuille appeler soumission
mais quand je change de feuille et je sélectionne des éléments les premiers éléments sont écraser par la
deuxième sélection. C'est que les éléments sélectionner devrait passer à la ligne suivante si celle-ci est occupé
voici les deux macro utilisée la première est sur 6 des sept feuille et la deuxième est sur une feuille

Dim fin As Integer, plage As Range, cellule As Range, i As Integer 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
fin = Range("F65536").End(xlUp).Row 
Set plage = Range("B2:G" & fin) 
If Target.Count > 1 Then Exit Sub 
If Not Application.Intersect(Target, plage) Is Nothing Then 
For Each cellule In plage 
If Target = cellule Then 
With Sheets("Soumission") 
If .Range("A29") = "" Then i = 0 Else i = i + 1 
.Range("A29").Offset(i, 0) = "Cadrage" 
.Range("B29").Offset(i, 0) = Cells(4, Target.Column) 
.Range("J29").Offset(i, 0) = Target.Value 
Exit Sub 
End With 
End If 
Next 
End If 
End Sub

Option Explicit 


Public Sub Devis() 
Dim Plg As Variant, L As Integer, Li As Integer 
With Worksheets("Devis") 
Plg = .Range("B14:K" & .Range("B65536").End(xlUp).Row) 
End With 

With Worksheets("Soumission") 
.Range("A29:A57").ClearContents 
.Range("J29:J57").ClearContents 
Li = 29 
For L = 1 To UBound(Plg, 1) 
If Plg(L, 2) <> "" Or Plg(L, 5) <> "" Or Plg(L, 6) <> "" Then 
.Range("A" & Li) = Plg(L, 1) 
.Range("J" & Li) = Plg(L, 10) 
Li = Li + 1 
End If 
Next L 

End With 

End Sub 

Private Sub CommandButton1_Click() 
Devis 
End Sub
Configuration: Windows XP
Internet Explorer 6.0

__________________________
Rened
-----

[invitec94d2bbe]

Bonsoir,


j'ai essayé de reconstituer le fonctionnement des macro
mais sans données

dans une des macro il y a :

With Worksheets("Soumission")
.Range("A29:A57").ClearContent s
.Range("J29:J57").ClearContent s


ClearContents efface le contenu des range, le pb n'est il pas là ?

[invite149ad00e]

Bonjour The Cat 2007
Voici fichier abréger sans les deux formules insérées sinon le fichier est trop lourd normalement ils font patie du même fichier
A l'heure actuel ce qui fonctionne
Premièrement lors que je sélectionne a l'aide de la souris sur la feuille Teinture
un montant$924 qui a été préalablement indiquer dans la case jaune: exemple 3 va donné $924,00 en dessous de Chambres
cela transfert sur la feuille soumission en a29 Pré Vernis en b 29 Chambres et
en j29 $924.00 si je fait une autre sélection toujours sur la feuille teinture,
cellule jaune en dessous de chambre 2000 cela transfert sur la feuille soumission en a30 prévernis
b30 escalier et en j30 $2000,00 cellule jaune en dessous de chambre
La sélection a passer à la ligne suivante sur soumission automatiquement
Cela fontionne pour toutes les feuilles
Le problème est que lorsque je change de feuille exemple céramique et que je sélectionne dans celle-ci cela écrase la sélection précédente celle dans teinture la sélection devrait passer à la ligne suivante lors que la ligne précédente est occupé.
Aussi lors que je sélectionne dans devis qui comprend l'autre macro qui elle est lancer par un bouton cela aussi va ecraser les sélection précédente.
Macros utiliées
macros pour les feuilles teinture, ceramique et les autres

Dim fin As Integer, plage As Range, cellule As Range, i As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
fin = Range("F65536").End(xlUp).Row
Set plage = Range("A2:Q" & fin)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, plage) Is Nothing Then
For Each cellule In plage
If Target = cellule Then
With Sheets("Soumission")
If .Range("A29") = "" Then i = 0 Else i = i + 1
.Range("A29").Offset(i, 0) = "Pré Vernis"
.Range("B29").Offset(i, 0) = Cells(5, Target.Column)
.Range("J29").Offset(i, 0) = Target.Value
Exit Sub
End With
End If
Next
End If
End Sub

macros utilisées dans devis

Option Explicit


Public Sub Devis()
Dim Plg As Variant, L As Integer, Li As Integer
With Worksheets("Devis")
Plg = .Range("B14:K" & .Range("B65536").End(xlUp).Row)
End With

With Worksheets("Soumission")
.Range("A29:A57").ClearContents
.Range("J29:J57").ClearContents
Li = 29
For L = 1 To UBound(Plg, 1)
If Plg(L, 2) <> "" Or Plg(L, 5) <> "" Or Plg(L, 6) <> "" Then
.Range("A" & Li) = Plg(L, 1)
.Range("J" & Li) = Plg(L, 10)
Li = Li + 1
End If
Next L

End With

End Sub

Private Sub CommandButton1_Click()
Devis
End Sub

Espérant que cela pourras vous aider
Rened

[invitec94d2bbe]

Bj,

ai mis la sub dans teinture et les autres aux bons endroits ....

Private Sub Worksheet_SelectionChange(ByVa l Target As Range)
fin = Range("F65536").End(xlUp).Row
Set plage = Range("A2:Q" & fin)
If Target.Count > 1 Then Exit Sub

'If Not Application.Intersect(Target, plage)
'-> target renvoi 924 et pas une valeur de plage
'd'ou aiguillage au end if en bas de la sub ....
'j'en suis là et pas de transfert à la feuille soumission forcément ....

If Not Application.Intersect(Target, plage) Is Nothing Then
For Each cellule In plage
If Target = cellule Then
With Sheets("Soumission")
If .Range("A29") = "" Then i = 0 Else i = i + 1
.Range("A29").Offset(i, 0) = "Pré Vernis"
.Range("B29").Offset(i, 0) = Cells(5, Target.Column)
.Range("J29").Offset(i, 0) = Target.Value
Exit Sub
End With
End If
Next
End If
End Sub

[A voir en vidéo sur Futura]

[invitec94d2bbe]

Bonjour,

pb identifié je crois ...
la valeur de a29 n'était pas chargée, d'où i qui ne bougeait pas, donc pas de saut de ligne ....

With Sheets("Soumission")
        If .Range("A29").Value = "" Then i = 0 Else i = i + 1
            .Range("A29").Offset(i, 0)[B].Value [/B = "Pré Vernis"
            .Range("B29").Offset(i, 0)[B].Value [/B = Cells(5, Target.Column)
            .Range("J29").Offset(i, 0)[B].Value [/B = Target.Value
        Exit Sub
End With

[invitec94d2bbe]

re bj,

petit problème de mise en forme ...

With Sheets("Soumission")
    If .Range("A29").Value = "" Then i = 0 Else i = i + 1
         .Range("A29").Offset(i, 0).Value  = "Pré Vernis"
         .Range("B29").Offset(i, 0).Value = Cells(5, Target.Column)
         .Range("J29").Offset(i, 0).Value = Target.Value
Exit Sub
End With

[yoda1234]

Bonsoir,

notre superbe forum met à votre disposition quelques balises permettant un plus grand confort de lecture, comme par exemple celle-ci: .

Ce qui donne par exemple:
Sans la balise:

With Sheets("Soumission")
If .Range("A29").Value = "" Then i = 0 Else i = i + 1
.Range("A29").Offset(i, 0).Value = "Pré Vernis"
.Range("B29").Offset(i, 0).Value = Cells(5, Target.Column)
.Range("J29").Offset(i, 0).Value = Target.Value
Exit Sub
End With
Avec la balise:

With Sheets("Soumission")
    If .Range("A29").Value = "" Then i = 0 Else i = i + 1
         .Range("A29").Offset(i, 0).Value  = "Pré Vernis"
         .Range("B29").Offset(i, 0).Value = Cells(5, Target.Column)
         .Range("J29").Offset(i, 0).Value = Target.Value
Exit Sub
End With

Étonnant, non?

[invite149ad00e]

Bonjour The Cat207 et yoda 1234

Un gros merci à tout les deux j'ai enfin la réponse.
Cela va facilité mon travail
Merci encore une fois
Rened

[invite149ad00e]

Rebonjour
10 minutes plustard
J'ai parlé trop vite
Cela a fonctionné pour la première fois
mais pas pour la seconde pourquoi ?
ON est revenue comme au début
Je tente toujours de comprendre
Rened

[invite149ad00e]

Bonjour The Cat2007 et yoda1234
Voici un nouveau fichier un peu plus complet
j'ai changer les macros avec value ajouté
mais cela ne fonctionne qua moitié
avec la feuille teinture cela semble fonctionner
mais lors qu'on change de feuille cela fonctionne aléatoire
quand a devis ils écrase automatiquement les sélection précedente.
J'espère que ce nouveau fichier va vous aider d'avantage.
Je continue mes recherche
Rened

[invitec94d2bbe]

Re bj,

1 ) la valeur prise par target est aléatoire :
après avoir entré une valeur, si j'appuie sur ENTER au clavier,
zz dans la sub donne "vide", car ENTER provoque un saut de cellule et on tombe sur une case vide ou qui n'aura pas la valeur souhaitée ...

2 ) If Target = cellule -> ai ajouté .value pour assurer la lecture de "cellule".
en mode débug, il n'est pas évident que "cellule" écrit seule, égale quelque chose ...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Stop
fin = Range("F65536").End(xlUp).Row
Set plage = Range("B2:Q" & fin)
zz = Target.Value 'zz espion qui permet de voir si la valeur de target est bien passée
'Stop
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, plage) Is Nothing Then
  For Each cellule In plage
    If Target = cellule.Value Then
      'Stop
      With Sheets("Soumission")
          If .Range("A29").Value = "" Then i = 0 Else i = i + 1
          .Range("A29").Offset(i, 0).Value = "Céramique"
          .Range("B29").Offset(i, 0).Value = Cells(4, Target.Column)
          .Range("J29").Offset(i, 0).Value = Target.Value
          Exit Sub
      End With
    End If
  Next
End If
End Sub

[invite149ad00e]

Bonjour The Cat 2007

Merci encore pour ton aide.
La solution n'est pas évidente.
Rened

[invitec94d2bbe]

Re bj,

Dans EXCEL / outils / options / onglet modification /
décocher : déplacer la sélection après validation

ou ajouter dans un module la sub ci dessous :
la sub se lance automatique à l'ouverture du classeur et désactive l'option
sub auto_open
Application.MoveAfterReturn = false
end sub

[invitec94d2bbe]

Re bj,
petite précision :c'est pour remédier au pt
1 ) la valeur prise par target est aléatoire

en prenant cette option, quand on fait ENTER on ne change pas de cellule ...

[invite149ad00e]

Bonjour The Cat 2007
Après essaie de excel outils/option/déplacer........
je n'ai pas eu de résultat concluant.
Je cherche toujours
Je tente une nouvelle approche avec
lg = Sheets("devis").Range("a29").E nd(xlDown).Row + 1
selon une autre discution sur un autre forum.
Rened