Probleme avec un private sub sur excel 2000

Signaler
Messages postés
32
Date d'inscription
vendredi 27 juillet 2007
Statut
Membre
Dernière intervention
22 novembre 2007
-
Messages postés
32
Date d'inscription
vendredi 27 juillet 2007
Statut
Membre
Dernière intervention
22 novembre 2007
-
bonjour

j'ai fais une macro pour copier une cellule mais j'ai quelques problemes que je n'arrive pas a résoudre

la mocro copie une cellule en fontion de la valeur qui se trouve en b2
grace a un private sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer

If Target.Address(False, False) = "B2" Then
For I = 0 To Target.Value - 1
Range("D10").Offset(I, 0).Application.Run "Classeur1Macro1"
Next
End If
End Sub

la macro pour copier la cellule est

Sub Macro1()
' Macro enregistrée le 31/07/2007 par POSTE09
'

Range("B8").Select
Selection.Copy

Selection.Cells(3, 1).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
End Sub

Dans la cellule B8 se trouve "toto"

quand je saisie 3 en B2 j'ai le resultat suivant

B8 TOTO
B9
B10 TOTO
B11
B12 TOTO
B13
B14 TOTO

premier probleme j'ai quatre toto alors qui m'en faut que trois

deusieme probleme si je saisie une valeur dans la cellule B15 , apres avoir lancer la macro j'obtien le resultat suivant

B8 TOTO
B9
B10
B11
B12
B13
B14
B15 MARCEL
B16
B17 TOTO
B18
B19 TOTO
B20
B21 TOTO

Le TOTO se copie sous marcel alors que je veux qu il se copier entre B10 et B14

troisieme probleme je ne sais pas quel code utiliser pour copier toute la ligne de la cellule B8

comment dois je faire si possible donnez moi des exemples car je suis debutant

merci pour vos reponses

4 réponses

Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Regarde ça et dis-moi si c'est ce que tu cherchais à faire

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Integer
   
    If Target.Address(False, False) = "B2" Then
        For I = 1 To Target.Value
            Macro1 I
        Next
    End If
End Sub

Sub Macro1(Décalage As Integer)
    Range("B8").Copy
    Range("B8").Offset(Décalage, 0).PasteSpecial Paste:=xlValues
End Sub

****************************************************
En passant, cette ligne ne peut pas fonctionner écrite comme elle l'est
Range("D10").Offset(I, 0).Application.Run "Classeur1Macro1"

MPi
Messages postés
32
Date d'inscription
vendredi 27 juillet 2007
Statut
Membre
Dernière intervention
22 novembre 2007

bonsoir MPi

ton code marche bien meme si j'ai du mal à le comprendre
j'ai deja un probleme en moins la copie de toto sous marcel
 la modification de cette ligne me permet d'avoir 5 toto quand je saisie 5 en B2 et plus 6 comme avant

For I = 1 To Target.Value -1

par contre j ai testé  de décaler la copie d'une ligne vers le bas en le modifiant comme ça
 
For I = 2 To Target.Value + 0

ça me donne ceci

B8 TOTO
B9
B10 TOTO 
B11 TOTO
B12 TOTO
B13 TOTO

et non le resultat souhaité si dessous

B8 TOTO
B9
B10 TOTO
B11
B12 TOTO
B13
B14 TOTO

Heu ! pourquoi B9 et pas les autres ( B11 et B13)  ???

dois je integrer la ligne dans une boucle ??
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Tu dois comprendre que chaque fois que tu inscris une valeur dans une cellule, l'événement Worksheet_Change est appelé, même à l'intérieur de ta boucle.

C'est pour ça que je passe la valeur de I dans la Macro1.
De cette façon, le code n'ira pas écrire un peu partout selon son humeur...
Le plus simple serait de passer par un bouton ou autre.

Réfléchis à ta boucle... tu inscris 3 dans la cellule et tu veux avoir 3 valeurs inscrites, doncFor i 1 to 3 ( 3 Target.Value)
te donnera 3 valeurs

Si tu veux sauter une ligne multiplie le paramètre par 2

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Integer
  
    If Target.Address(False, False) = "B2" Then
        For I = 1 To Target.Value
            Macro1 I * 2  ' <<<
        Next
    End If
End Sub

MPi
Messages postés
32
Date d'inscription
vendredi 27 juillet 2007
Statut
Membre
Dernière intervention
22 novembre 2007

Bonsoir MPi


j'ai bidouillé le code que tu m as donnés dans ton post du 18/08/07 à 14:46:41


ça donne ça






Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer





If Target.Address(False, False) = "B2" Then
For I = 1 To Target.Value - 1
Macro1 I * 2
Next
End If
End Sub


Sub Macro1(Décalage As Integer)


Range("B8").Copy
Range("B8").Offset(Décalage, 0).PasteSpecial Paste:=xlValues
End Sub




ça me donne le résultat suivant avec TOTO en B8 et 5 en B2


B8 TOTO
B9
B10 TOTO
B11
B12 TOTO
B13
B14 TOTO
B15
B16 TOTO
B17
B18
B19
B20 MARCEL


Le private sub copie TOTO le nombre de fois indiqué dans la cellule B2, entre TOTO en B8 et MARCEL en B20


ça c est bon


Avant de copier TOTO Je souhaite supprimer les lignes entre TOTO B8 et MARCEL B20 avec se code



Dim A As Long
Dim Plage As Range
For x = 1 To 100
Set Plage = Range("B9:B" & Range("B9").End(xlDown).Row)
For A = Plage.Cells.Count To 1 Step -1
If Plage.Cells(A).Value <> MARCEL Then 'arret de la boucle si la cellule active est égale à MARCEL
Plage.Cells(A).EntireRow.Delete
Exit For
End If
Next
Next x



Et insérer des lignes vierges avec



Rows(x).Insert Shift:=xlDown



Mais la non plus je n'arrive pas à mettre ces codes dans le private sub


en résumé la macro doit faire apres la saisie du chiffre en B2


1) supprimer les lignes entre TOTO et MARCEL

2) inserer des lignes vierges (11 lignes si la valeur de B2 est 5) La valeur de B2 + 6 lignes pour conserver l'equart entre TOTO et MARCEL

3) copier TOTO selon la valeur de B2







dans mon deuxieme post



http://www.vbfrance.com/infomsg_PROBLEME-AVEC-EVENEMENT-PRIVATE-SUB_997963.aspx


j'ai la meme chose mais avec la cellule D2



une macro qui se lance avec le private sub qand je modifis la valeur de D2
la macro se lance si je tape directement le nombre dans la cellule D2 , mais si je mes une formule dans la cellule (exemple = A1-1) ça ne marche pas





Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
If Target.Address(False, False) = "D2" Then
For I = 1 To Target.Value - 1
Macro2 I * 2
Next
End If
End Sub

Sub Macro2(Décalage As Integer)
Range("B8").Copy
Range("B8").Offset(Décalage, 0).PasteSpecial Paste:=xlValues
End Sub





 


Jack m a répondu ceci :


Si "D2" contient "A1-1", c'est du texte pour lui.
Il faut donc lui demander de calculer cette valeur avant.



Il faut donc envoyer le contenu dans une cellule intermédiaire et la précéder du signe Range("W400").Value "=" & Target.Value


puis utiliser le résultat calculé dans W400 pour le resteje ne suis pas arrivé à mettre en pratique ce code



j'ai testé en copiant la valeur de D2 dans E2 mais ça ne marche pas non plus








mes explications sont elles claires ?

 




Bobbob83