Aide sur une macro

[jemmy1989]

Sub Macro1()
'
' Macro1 Macro
'

'
For i = 1 To 73
For Each j In Array(2, 5, 8, 11, 14, 17, 21, 24, 27, 30, 33, 36, 40, 43, 46, 49, 52, 55, 59, 62, 65, 68, 71, 74, 77, 80)
If Cells(i, 3).Value = 1 Then
If Cells(i, 4).Value < Cells(i, 3).Value Then

    
 Range("A" & i & ":B" & i).Copy
 
 Sheets("TRV").Cells(j, 2).Paste

End If
End If
Next i
Next j

End Sub

bonsoir
je suis un débutant sur VBA, avec ce code je voudrais copier les cellules (i, y) (i = 1 To 73) et y=2 dans une feuille et les coller dans une autre feuille dans les cellules
(j, y) avec j qui comporte ces valeurs (2, 5, 8, 11, 14, 17, 21, 24, 27, 30, 33, 36, 40, 43, 46, 49, 52, 55, 59, 62, 65, 68, 71, 74, 77, 80) et j=2
mais je voudrais que ce soit à tours de role c'est à dire que la celules (1, 2) de la premiére feuille sera copier dans la cellule (2, 2) de la deuxiéme feuille puis (2, 2) dans (5, 2) puis (3, 2) dans (8, 2).....etc

mais quand je lance le code ça ne veux pas fonctionner et j'ai des erreurs

 

[Staple1600]

Re : Aide sur une macro

Bonjour à tous

jemmy1989
On y verrait plus clair avec un fichier Excel exemple, non ?

Néanmoins avec ce que j'ai compris, testes ceci dans un classeur vierge avec deux feuilles
Mode d'emploi
Tu lances une seule fois la macro nommée CreerLesDonneesDeTest
Ensuite tu te mets sur la feuille 1 pour lancer d'abord la macro recopierA
Tu verras alors que des données sont copiées sur la feuille 2
(mais sont-ce bien les bonnes ?)
Puis tu lances la macro recopierB et tu verras que le résultat est différent cette fois-ci

Sub CreerLesDonneesDeTest()
With Sheets(1).Range("B1:B73")
.Value = "=ROW()"
.Offset(, 1) = 1
.Offset(, 2) = "=0.09988765*ROW()"
.Item(1, 1).Resize(10, 3).Interior.ColorIndex = 6
End With
MsgBox "Données de test créées", vbInformation, "Informations"
End Sub

Sub recopierA()
Dim i&, j&, lig
lig = Array(2, 5, 8, 11, 14, 17, 21, 24, 27, 30, 33, 36, 40, 43, 46, 49, 52, 55, 59, 62, 65, 68, 71, 74, 77, 80)
Sheets(2).Cells.Clear
'je voudrais copier les cellules (i, y) (i = 1 To 73) et y=2 dans une feuille
For i = 0 To UBound(lig)
If Cells(i + 1, 3).Value = 1 And Cells(i + 1, 4).Value < Cells(i + 1, 3).Value Then
'et les coller dans une autre feuille dans les cellules (j, y) avec j qui comporte ces valeurs
Cells(i + 1, 2).Copy Sheets(2).Cells(lig(i), 2)
End If
Next
Application.Goto Sheets(2).Range("B1"), True
End Sub

Sub recopierB()
Dim i&, j&, lig
lig = Array(2, 5, 8, 11, 14, 17, 21, 24, 27, 30, 33, 36, 40, 43, 46, 49, 52, 55, 59, 62, 65, 68, 71, 74, 77, 80)
Sheets(2).Cells.Clear
'je voudrais copier les cellules (i, y) (i = 1 To 73) et y=2 dans une feuille
For i = 0 To UBound(lig)
'et les coller dans une autre feuille dans les cellules (j, y) avec j qui comporte ces valeurs
Sheets(2).Cells(lig(i), 2) = Sheets(1).Cells(i + 1, 2)
Next
Application.Goto Sheets(2).Range("B1"), True
End Sub

 

[jemmy1989]

Re : Aide sur une macro

bonsoir

voici le fichier

ce que je veux faire c'est que les celules A et B (ProduitX et prix X) dans la feuille 02-066 soit copier et coller dans la feuille TRV comme le montre le fichier mais avec ces conditions

il faut que le numero dans la cellule C avoisinante ne soit pas 0 et que celui de la cellules D soit inférieur au numéro de la cellule C
il faut qu'ils soit copier dans toute les cellules de la feuille TRV, exemple, B2 et D2 puis B5 et D5 puis B8 et D8.....
il faut qu'il mélange, c'est à dire il copier le produit A avec son prix puis le produit B puis C, D, E.... et il tourne en boucle

 

[jemmy1989]

Re : Aide sur une macro

bonsoir staple1600 oui j'ai bien testé ce que tu m'a proposé, d'ailleurs je te remercie beaucoup pour la peine que ta pris, dans mon précédent message je té bien expliqué ce que je veux faire avec le fichier joint

 

[jemmy1989]

Re : Aide sur une macro

j'ai essayé cette macro que tu a posté mais je n'ai pas compris, elle donne des msgbox
tu ne l'a pas trouver dans le fichier car je l'ai utiliser sur un autre classeur vu qu'elle crée ces propres données

je té préparer un autre fichiers avec le résultat souhaité

je voudrais que la macro copie les cellules A et B avec les conditions

If Cells(i, "C").Value = 1 Then
      If Cells(i, "D").Value < Cells(i, "C").Value

ces conditions en fonctionné mais je voudrais ajouter d'autres conditions

1) à chaque produit copié il doit ajoué un 1 dans la cellule D avoisinante comme ça il ne repassera pas dessus

2) il faut qu'il mélange, c'est à dire il ne copie pas le méme produit deux fois si d'autre produits différents son diponnible,

voila ce qu'il doit faire dans le fichier que je té donné

il copie le produit B8 avec son prix, il ajoute 1 dans la cellule D12 avoisinante et le colle dans la cellules B2 de la feuille TRV,
puis le produit C6 il ajoute 1 dans la cellule D19 avoisinante et le colle dans la cellules D2 de la feuille TRV
puis D2 il ajoute 1 dans la cellule D25 avoisinante et le colle dans la cellules B5 de la feuille TRV
puis il ne copie pas D4 mais il saute à E1 il ajoute 1 dans la cellule D29 avoisinante et le colle dans la cellules D5 de la feuille TRV
puis F1 il ajoute 1 dans la cellule D32 avoisinante et le colle dans la cellules B8 de la feuille TRV
puis G1 il ajoute 1 dans la cellule D42 avoisinante et le colle dans la cellules D8 de la feuille TRV
puis H2 il ajoute 1 dans la cellule D49 avoisinante et le colle dans la cellules B11 de la feuille TRV
puis I2 il ajoute 1 dans la cellule D57 avoisinante et le colle dans la cellules D11 de la feuille TRV
et la il a fait une boucle, puis il revient au début et il copie D4 il ajoute 1 dans la cellule D27 avoisinante et le colle dans la cellules B14 de la feuille TRV
puis F4 il ajoute 1 dans la cellule D35 avoisinante et le colle dans la cellules D14 de la feuille TRV
puis H4 il ajoute 1 dans la cellule D51 avoisinante et le colle dans la cellules B17 de la feuille TRV
puis I8 il ajoute 1 dans la cellule D63 avoisinante et le colle dans la cellules D17 de la feuille TRV
et là il ne reste plus rien

Sub Macro2()
'
' Macro2 Macro
'
'seulement pour les ligne 2 à 73 pour la feuille 05-066
  j = 2
  For i = 1 To 73
'il faut que le numero dans la cellule C avoisinante ne soit pas 0 et que celui de la cellules D soit inférieur au numéro de la cellule C
    If Cells(i, "C").Value = 1 Then
      If Cells(i, "D").Value < Cells(i, "C").Value Then
[COLOR="#00FF00"]'copie puis coller dans TRV[/COLOR]
        Range("A" & i & ":B" & i).Copy Sheets("TRV").Cells(j, "B")
      End If
    End If
    j = j + 3
  Next i

End Sub

 

[Staple1600]

Re : Aide sur une macro

Re

Je te reprends ton exemple
On a en C12 1 et en D12 1
donc D12 < C12 n'est pas vrai
C'est ce que tentait de te montrer ma macro avec les MsgBox
Et c'est ce que montre celle-ci aussi, non ??

Sub JeComprendsDeMoinsenMoins()
Dim i
i = 12 '12 parce que le produit B8 est en A12
If Cells(i, "C").Value = 1 Then
'If Cells(i, "D").Value < Cells(i, "C").Value Then
MsgBox "Valeur de  C" & i & " : " & Cells(i, "C").Value & Chr(13) & "Valeur de  D" & i & " : " & Cells(i, "D").Value
If Cells(i, "D").Value < Cells(i, "C").Value Then
MsgBox "La valeur en colonne C est inférieure à celle en colonne D"
Else
MsgBox Cells(i, "D").Value < Cells(i, "C").Value
End If
End If
End Sub

 

[jemmy1989]

Re : Aide sur une macro

non il n'y a rien en D12, je pense que tu n'a pas remarqué la remarque que je té fait dans la premiére feuille a propos des 1 en vert
c'est pas grave, voici le fichier excel avec les 1 verts supprimé

tout ce que je souhaite faire, je l'ai expliqué ici

je voudrais ajouter d'autres conditions

1) à chaque produit copié il doit ajoué un 1 dans la cellule D avoisinante comme ça il ne repassera pas dessus

2) il faut qu'il mélange, c'est à dire il ne copie pas le méme produit deux fois si d'autre produits différents son diponnible,

voila ce qu'il doit faire dans le fichier que je té donné

il copie le produit B8 avec son prix, il ajoute 1 dans la cellule D12 avoisinante et le colle dans la cellules B2 de la feuille TRV,
puis le produit C6 il ajoute 1 dans la cellule D19 avoisinante et le colle dans la cellules D2 de la feuille TRV
puis D2 il ajoute 1 dans la cellule D25 avoisinante et le colle dans la cellules B5 de la feuille TRV
puis il ne copie pas D4 mais il saute à E1 il ajoute 1 dans la cellule D29 avoisinante et le colle dans la cellules D5 de la feuille TRV
puis F1 il ajoute 1 dans la cellule D32 avoisinante et le colle dans la cellules B8 de la feuille TRV
puis G1 il ajoute 1 dans la cellule D42 avoisinante et le colle dans la cellules D8 de la feuille TRV
puis H2 il ajoute 1 dans la cellule D49 avoisinante et le colle dans la cellules B11 de la feuille TRV
puis I2 il ajoute 1 dans la cellule D57 avoisinante et le colle dans la cellules D11 de la feuille TRV
et la il a fait une boucle, puis il revient au début et il copie D4 il ajoute 1 dans la cellule D27 avoisinante et le colle dans la cellules B14 de la feuille TRV
puis F4 il ajoute 1 dans la cellule D35 avoisinante et le colle dans la cellules D14 de la feuille TRV
puis H4 il ajoute 1 dans la cellule D51 avoisinante et le colle dans la cellules B17 de la feuille TRV
puis I8 il ajoute 1 dans la cellule D63 avoisinante et le colle dans la cellules D17 de la feuille TRV
et là il ne reste plus rien

 

[jemmy1989]

Re : Aide sur une macro

Bonsoir à tous


Comment cela, il n'y a rien en D12 !
Regarde la pièce jointe 346320

regarde le dernier fichier en piece jointe, j'ai supprimé les 1 vert

Cette macro fait bien la première partie de ce que tu souhaites, non : mettre des 1 en colonne D si 1 en colonne C ?

Sub MettredesUNS()
Dim c As Range, strG$
For Each c In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
If Cells(c.Row, "C") = 1 Then
If Len(Cells(c.Row, "D")) = 0 Then
Cells(c.Row, "D") = Cells(c.Row, "C")
End If
End If
Next
End Sub

oui elle fonctionne, c'est surtout le reste que je n'ai pas réussis a appliqué

 

[jemmy1989]

Re : Aide sur une macro

alors staple tu abandonne ?