macro copier ligne dans autre onglet si condition respectée

benbenper

Nouveau membre
#1
Bonjour,

Je cherche à copier des lignes respectant une condition
Voici l'entête du tableau que j'ai :
Date / Nom / Compte / Valeur

Je souhaite copier les lignes affichant le numéro de compte
62 dans l'onglet 62 et ainsi de suite
63 dans l'onglet 63 , etc.

J'ai de nombreux tableaux à retraiter et cherche un / des conseil(s) (descriptif de la procédure) pour créer cette macro sous VBA.



D'avance merci pour ce gros coup de pouce

Un novice
 

spysnl

Expert
#2
Pour faire cela, il faut quelques notions de base en prog....
Idem pour expliquer ce dont tu as besoins.

Par exemple, si tu veux copier le N° de compte 62 dans l'Onglet 62, alors il ne s'agit pas d'une copie subordonnée à une condition. On utilise pour cela une variable:


NbLignes = nombre de lignes de ton tableau

Code:
dim i as integer

for i=1 to NbLignes

 ActiveWorkBook.Sheets(i).Cells(1,1).Text = ActiveWorkBook.Sheets("Feuille_du_Tableau").Cells(i,3).Text

next

bon, c'est très simplifié, mais cela copie le numéro de compte X dans la première cellule de la feuille X, à partir de ton tableau de départ qui est sur la feuille "Feuille_du_Tableau".

Ca t'aide ?
 

nono le golfeur

Nouveau membre
#3
Bonjour,

Je me mets au VBA pour mon boulot et je bloque sur un truc assez stupide, afin d'automatiser un fichier j'aimerai recopier quelque cellules d'une ligne dans une autre feuille si une condition est respectée.

Je m'explique :

La cellule J d'une ligne peut contenir différents mots pour simplifier X, Y et Z
Si le mot contenu dans "J" est Y alors je voudrais que les cellules A à D soit recopier dans la feuillle 2
Et ainsi de suite pour toutes les lignes

J'ai beau prendre le problème dans tous les sens ou essayer d'abord d'enregistrer puis d'automatiser, pas moyen !!!

Merci d'avance si qq connais une solution !!!
 

zeb

Modérateur
#4
Ecris-nous l'algo en français, on tachera de te le transcrire en VB.
 

nono le golfeur

Nouveau membre
#5
Pour la feuille de données "feuille1"
Si la cellule J3 est égale à "Committed"
Alors copier celulle A3:H3 vers la feuille 2 (commencé copiage en A3)
Et ainsi de suite

Je suis débutant mais j'ai vraiment envie de m'y mettre, alors j'ai essayé de le faire en VBA mais il y a un truc qui fonctionne pas vu que copie pas !!!!

Merci, bonne journée
 

zeb

Modérateur
#6
Tu es aussi débutant en français ? On dit copie, pas copiage ! :D
Bon j'arrête de me payer ta poire.

Tu veux vraiment t'y mettre, le mieux c'est de faire et comprendre ce que tu fais, quitte à ce qu'on te l'explique.

Alors fais ce qui suit :
■ Démarre l'enregistreur de macro.
■ Sélectionne la feuille Feuil1 (Au pire, sélectionne une autre feuille avant pour voir ce qu'écrit l'enregistreur pour sélectionner ta feuille 1)
■ Sélectionne la plage A3:H3 de cette feuille.
■ Copie.
■ Sélectionne la feuille Feuil2.
■ Sélectionne la cellule A3.
■ Colle.
■ Arrête l'enregisteur de macro.

Et publie le code obtenu ici. Tu auras bientôt une belle macro, faite par toi qui répondra à tes besoins :)
 

nono le golfeur

Nouveau membre
#7
Ok pour Copiage, Niveau français c'était très très moyen !!!

Bon lorsque j'enregistre à la main la macro après un tri de ma collone J voila ce que j'obtient :

[cpp]Sub CopyCommittedCells()


Sheets("Orders Funnel").Select
Range("A3:H18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Committed Funnels").Select
Range("A2").Select
ActiveSheet.Paste
Range("I8").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Range("F2").Select
End Sub
[/cpp]

Le seul problème c'est que je voudrais le faire automatiquement le tri et le "COPIAGE !"
En insérant les cellules dans des nouvelles ligne si possible mais là j'abuse peut etre !
 

zeb

Modérateur
#8
Ah, tu copies la zone A3:H18 dans la cellule A2 :/ C'est nouveau.
Considérons que tu veux toujours coller A3:H3 dans A3 d'une autre feuille.

Je réécris ta procédure :
Code:
Sub CopyCommittedCells()
    Sheets("Orders Funnel" ).Range("A3:H3" ).Copy
    Sheets("Committed Funnels" ).Range("A2" ).Paste
End Sub
C'est plus simple.

Ajoutons le test :
Code:
Sub CopyCommittedCells()
    If Sheets("Orders Funnel").Range("J3").Text = "Committed" Then
        Sheets("Orders Funnel").Range("A3:H3").Copy
        Sheets("Committed Funnels").Range("A3").Paste
    End If
End Sub
Est-ce toujours clair ?

Bon maintenant, on le fait pour une ligne, n'importe laquelle :
Code:
Sub CopyCommittedCells()
    Dim r As Integer
    Dim sOF As Worksheet
    Dim sCF As Worksheet
    
    Set sOF = Worksheets("Orders Funnel")
    Set sCF = Worksheets("Committed Funnel")
    
    r = <N'importe laquelle>
        
    If sOF.Cells(r, 10).Text = "Committed" Then
        sOF.Range(Cells(r, 1), Cells(r, 7)).Copy
        sCF.Cells(r, 1).Paste
    End If
End Sub
J'utilise des variables pour les feuilles, c'est plus concis, mais pas obligatoire.
Dans ce dernier code, il y a un problème : la ligne de départ et la ligne d'arrivée sont la même dans des feuilles différentes.

Bon, maintenant pour toutes les lignes de 3 à 10000 :
Code:
Sub CopyCommittedCells()
    Dim rOF As Integer
    Dim rCF As Integer
    Dim sOF As Worksheet
    Dim sCF As Worksheet
    
    Set sOF = Worksheets("Orders Funnel")
    Set sCF = Worksheets("Committed Funnel")
    
    rCF = <première ligne libre de Committed Funnel>
    
    For rOF = 3 To 10000        
        If sOF.Cells(rOF, 10).Text = "Committed" Then
            sOF.Range(Cells(rOF, 1), Cells(rOF, 7)).Copy
            sCF.Cells(rCF, 1).Paste
        End If
    Next
End Sub
Alors ?

Ben il te reste à initialiser rCF, et à mettre autre chose que For 3 To 10000 pour coller à ton problème. Une boucle While est sans doute plus adéquate.
 

nono le golfeur

Nouveau membre
#9
Merci pour ton message,

Alors ca fonctionne bien car ça selection bien une ligne avec Committed mais après ça stop pour une erreur
'1004' pour un Range qui foire ligne 15...

j'ai pas encore changer For 3 to 1000 pour l'instant et j'ai :

[cpp]Sub CopyCommittedCells()
Dim rOF As Integer
Dim rCF As Integer
Dim sOF As Worksheet
Dim sCF As Worksheet

Set sOF = Worksheets("Orders Funnel")
Set sCF = Worksheets("Committed Funnels")

rCF = 2

For rOF = 3 To 10000
If sOF.Cells(rOF, 10).Text = "Committed" Then
sOF.Range(Cells(rOF, 1), Cells(rOF, 7)).Copy
sCF.Range(Cells(rCF, 1)).Paste
End If
Next
End Sub
[/cpp]

Alala c'est vraiment bizare hier je prend un exemplaire de formulaire pour inserer des valeurs dans une nouvelle ligne et tout à fonctionné sans pb, maintenant c Opérationel mais ça je sais pas pourquoi ca veut pas !!
 

zeb

Modérateur
#10
Mais non, tu as mal lu la ligne 15 de mon post (surtout depuis que je l'ai corrigé :whistle: )
 

nono le golfeur

Nouveau membre
#11
He oui désolé si je me plante dans les copier/coller maintenant que vais-je faire ?? du tricot peut-être.

Anyway, lorsque je remplace avec : sCF.Cells(rCF, 1).Paste
alors j'obtient une erreur 438 : 'object doesn't support this property'

Je pense que de vais finir par jeter mon PC par la fenêtre !!

Pour info :

[cpp]Sub CopyCommittedCells()
Dim rOF As Integer
Dim rCF As Integer
Dim sOF As Worksheet
Dim sCF As Worksheet

Set sOF = Worksheets("Orders Funnel")
Set sCF = Worksheets("Committed Funnels")

rCF = 2

For rOF = 3 To 10000
If sOF.Cells(rOF, 10).Text = "Committed" Then
sOF.Range(Cells(rOF, 1), Cells(rOF, 7)).Copy
sCF.Cells(rCF, 1).Paste
End If
Next
End Sub
[/cpp]
 

zeb

Modérateur
#12
Bon ok, maintenant tu m'as foutu la honte : 1°, j'ai réussi à publier du code qui ne marche pas, 2°, j'ai failli te dégouter du VBA. :sarcastic:

Et comme ça :
Code:
Sub CopyCommittedCells()
    Dim rOF As Integer
    Dim rCF As Integer
    Dim sOF As Worksheet
    Dim sCF As Worksheet
 
    Set sOF = Worksheets("Orders Funnel")
    Set sCF = Worksheets("Committed Funnels")
    
    rCF = 2
 
    For rOF = 3 To 10000
        If sOF.Cells(rOF, 10).Text = "Committed" Then
            sOF.Range(sOF.Cells(rOF, 1), sOF.Cells(rOF, 7)).Copy sCF.Cells(rCF, rCF)
            rCF = rCF + 1
        End If
    Next
    Application.CutCopyMode = False
End Sub
(Testé et approuvé, cette fois :whistle: )

Remarque la ligne 15 qui incrémente rCF au fur et à mesure qu'on trouve des lignes "Committed" ;)
 

nono le golfeur

Nouveau membre
#13
Bon alors,

1° tu ne t'es pas ridiculisé du tout je suis le premier à ne pas avoir réussi à le faire fonctionner !!

2° Me dégouter du VBA c'est pas loin mais ça n'est pas de ta faute plutôt de la mienne qui m'entete sur un truc comme ça !

3° Le code fonctionne et copie les bonne données

4° Mais (car il y a un mais dsl...) les cellules sont pas copiées au bon endroit, elles se décalent d'une cellule a chq fois, la premier se copie en B2 puis la deuxieme ligne en C3 puis D4 etc.

En tout cas un grand merci à toi Zeb !!!
 

nono le golfeur

Nouveau membre
#14
Problème résolu en changeant :

sOF.Range(sOF.Cells(rOF, 1), sOF.Cells(rOF, 7)).Copy sCF.Cells(rCF,rCF)

par :

sOF.Range(sOF.Cells(rOF, 1), sOF.Cells(rOF, 7)).Copy sCF.Cells(rCF, 1)

Encore un enorme merci !!!!
 

nono le golfeur

Nouveau membre
#15
Rien qu'avec ton aide Zeb tout mon fichier est finis, plus qu'à Fignoler des détails et envoyer aux équipes... Merci !

Prochaines étapes pour moi Récrire sur les données à chaque fois qu'on recopie...

Merci,
 

zeb

Modérateur
#16
J'ai fais exprès de laisser une erreur pour que tu la corriges toi-même.............. :o







Bah voyons, tu n'as plus qu'a me croire maintenant :D
 

nono le golfeur

Nouveau membre
#17
C'est trop gentils !!!
 

Amos14

Expert
#18
Bonjour,
quand j'execute la commande dès qu'il y a écrit committed dans la cellule du fichier Orders Funnel, cela remplace ce qui avait été copié auparavant dans le fichier Committed Funnel. Moi je voudrais que la nouvelle ligne a copier se colle à la suite de l'ancienne(dans la 1ère ligne vide). Est-ce possible ?
Merci
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Staff en ligne
  • AccroPC2
    Fou du PC
  • LeeLarant
    Speedy Configales, le plus rapide de tout TH
Membres en ligne
  • kaneli
  • CMs4mvs
  • AccroPC2
  • LeeLarant
  • Yama310
Derniers messages publiés
Statistiques globales
Discussions
869 201
Messages
8 105 719
Membres
1 579 734
Dernier membre
kerolkas
Partager cette page
Haut