[VBA - Résolu] Faire un copier coller avec un critère

[Ginou]

Bonjour à tous,

J'ai un petit soucis avec mon VBA .
J'ai essayé de faire mon code pour faire un copier-coller qui fonctionne bof bof.

Sub copier_coller()

Set curCell = ThisWorkbook.Sheets("classement eleves")

Range("A2:G15").Copy Destination:=curCell.Range("A2")
Range("H2:H15").Copy Destination:=curCell.Range("J2")
Range("I2:I15").Copy Destination:=curCell.Range("L2")
Range("J2:J15").Copy Destination:=curCell.Range("O2")

End Sub

Je pense que ce code n'est pas le meilleur. J'aimerais en plus y intégrer un critère de sélection.
Si quelqu'un veut bien m'aider à l'améliorer

Je m'explique. Il y a une BDD élèves avec leur choix de destination. De plus, chaque destination aura son onglet. J'aimerais qu'en fonction des destinations choisies, le VBA reconnaisse les élèves et qu'il les mette dans l'onglet qui correspond.

Je vous remercie par avance.

 

[Paritec]

Re : [VBA] Faire un copier coller avec un critère

Bonjour Ginou le forum
bah c'est très simple, tu commences par nous créer les onglets avec ta macro, tu nous mets deux noms d'élèves pour chaque destination, dans ta Bdd, tu remet le fichier ainsi modifié, et on va te faire la macro qui va bien.
a+
Papou

 

[Robert]

Re : [VBA] Faire un copier coller avec un critère

Bonsoir Ginou, Papou, bonsoir le forum,

En pièce jointe ton fichier modifié. L'onglet classement eleves sert de modèle et il est masqué. Un seul bouton Destination dans l'onglet Feuil1 qui fait tout avec le code ci-dessous. Je me vois pas l'utilité de cet onglet d'ailleurs, on pourrait très bien le supprimer et placer le bouton dans la base de données...
Le code :

Sub copier_coller()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Byte 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim OD As Object 'déclare la variable OD (Onglet de Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("BDD eleves") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A3:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEl de la plage PL
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Sheets(CEL.Offset(0, 4).Value) 'définit l'onglet de destination OD (génère une erreur si c'est onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        With Sheets("classement eleves") 'prend en compte l'onglet "classement eleves"
            .Visible = True 'affiche l'onglet
            .Copy AFTER:=Sheets(Sheets.Count) 'copy l'onglet en dernière position
            ActiveSheet.Name = CEL.Offset(0, 4).Value 'renomme l'onglet
            Set OD = ActiveSheet 'définit l'onglet de destination OD
            .Visible = False 'masque l'onglet "classement eleves"
        End With 'fin de la prise en compte de l'onglet "classement eleves"
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    CEL.Resize(1, 7).Copy DEST 'colie la plage A:G de CEL et la colle dans DEST
    CEL.Offset(0, 7).Copy DEST.Offset(0, 9) 'copie la plage H de CEl et la colle dans la colonne J de DEST
    CEL.Offset(0, 8).Copy DEST.Offset(0, 11) 'copie la plage I de CEl et la colle dans la colonne L de DEST
    CEL.Offset(0, 9).Copy DEST.Offset(0, 14) 'copie la plage J de CEl et la colle dans la colonne O de DEST
Next CEL 'prochaine cellule de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Seuls les onglets correspondants à une destination d'élève dans la base de donnée sont créés (dans ton exemple, seul l'onglet New york sera crée puisque tu n'as mis qu'une seule données, Flemmarde !). Si il te les faut tous, on pourra adapter facilement...
Le fichier :

 

[Ginou]

Re : [VBA] Faire un copier coller avec un critère

Bonjour Paritec,

Merci d'avoir répondu. Comme tu me l'as demandé, j'ai modifié le doc en mettant plus de nom en fonction des destinations.

C'est super sympa et merci beaucoup

 

[Robert]

Re : [VBA] Faire un copier coller avec un critère

Bonsoir Ginou, Papou, bonsoir le forum,

As-tu regardé ma proposition Ginou ?

 

[Ginou]

Re : [VBA] Faire un copier coller avec un critère

Bonsoir Robert,

Le code est impressionnant pour moi ! Merci
Je n'avais pas pensé qu'en donnant une seule donnée cela pouvait gêner :s

Ton fichier est génial

Re merci

 

[Robert]

Re : [VBA] Faire un copier coller avec un critère

Bonsoir le fil, bonsoir le forum,

C'est pas que ça gêne... C'est que si on veut tester la fiabilité du code proposé il faut qu'on rajoute nous-même les données et c'est pénible...
Si ta base contient beaucoup plus de données, plutôt qu'une boucle cellule par cellule, il serait peut-être préférable d'utiliser le filtre automatique...

 

[Ginou]

Re : [VBA] Faire un copier coller avec un critère

Je comprends bien. Je n'ai pas réfléchi

Robert, est-il possible de mettre en vba une formule si dans une cellule ?

 

[Robert]

Re : [VBA] Faire un copier coller avec un critère

Bonsoir le fil, bonsoir le forum,

En principe oui ! Mais dis-moi où que je puisse y regarder de près... En fait tu as deux possibilités. Soit de coder la conditionnelle et de mettre le résultat, soit de mettre la formule conditionnelle dans la cellule. Quand j'utilise VBA je préfère la première solution. La cellule contient le résultat en dur de la condition...

 

[Ginou]

Re : [VBA] Faire un copier coller avec un critère

J'ai mis ma formule dans l'onglet "New York" et la cellule est rouge.
Tu verras, il y a beaucoup plus de données

J'aimerais m’éviter du vba parce que je maitrise mieux les formules excel.

J'ai dû insérer des lignes en plus dans la BDD eleves, et le VBA ne fonctionne plus aussi bien. Je ne sais pas ce que je dois modifier.

Merci

 

[Robert]

Re : [VBA] Faire un copier coller avec un critère

Bonsoir le fil, bonsoir le forum,

Ooooops ! Avec une formule pareille c'est trop galère... Désolé mais je te propose une solution VBA en dur. J'ai juste rajouté ce bout de code à la fin :

    'cacul des points TOEFL
    Set OP = Sheets("Pondération") 'définit l'onglet OP
    DLM = OP.Cells(Application.Rows.Count, 3).End(xlUp).Row 'définit la dernière ligne étidée DLM de la colonne 3 (=C) de l'onglet OP
    For LI = DLM To 4 Step -1 'boucle inversée sur les cellules du "score max" de l'onglet "Pondération" de la dernière à la première
        'si la cellule en colonne H de CEL (TOEFL) est inférieure à la cellule de la boucle,
        'récupère les points en colonne D, sort de la boucle
        If CEL.Offset(0, 7) < OP.Cells(LI, 3) Then DEST.Offset(0, 10).Value = OP.Cells(LI, 4).Value: Exit For
    Next LI 'prochaine cellule de la boucle inversée

Le fichier Modifié :

 

[Ginou]

Re : [VBA] Faire un copier coller avec un critère

Merci beaucoup Robert. Tu m'as beaucoup aidé.

Je vais me débrouiller avec ce code pour l'appliquer à d'autres critères.

 

[Ginou]

Re : [VBA - Résolu] Faire un copier coller avec un critère

Re bonjour Robert,

Voici le fichier

Merci
Ginou

 

[Robert]

Re : [VBA - Résolu] Faire un copier coller avec un critère

Bonsoir Ginou, bonsoir le forum,

En pièce jointe la version3. J'ai codé différemment pour ce soit plus clair pour toi.
Le code :

Sub copier_coller()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim OD As Object 'déclare la variable OD (Onglet de Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim LiC As Integer 'déclare la variable LiC (Ligne de la cellule Cel)
Dim LiD As Integer 'déclare la variable LiD (Ligne de la cellule de Destination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("BDD eleves") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A3:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEl de la plage PL
    LiC = CEL.Row 'définit la ligne LiC de la cellule CEL
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Sheets(CEL.Offset(0, 4).Value) 'définit l'onglet de destination OD (génère une erreur si c'est onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        With Sheets("classement eleves") 'prend en compte l'onglet "classement eleves"
            .Visible = True 'affiche l'onglet
            .Copy AFTER:=Sheets(Sheets.Count) 'copy l'onglet en dernière position
            ActiveSheet.Name = CEL.Offset(0, 4).Value 'renomme l'onglet
            Set OD = ActiveSheet 'définit l'onglet de destination OD
            .Visible = False 'masque l'onglet "classement eleves"
        End With 'fin de la prise en compte de l'onglet "classement eleves"
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    LiD = OD.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit Ligne LiD de la cellule de destination DEST
    O.Range(O.Range("A" & LiC), O.Range("J" & LiC)).Copy OD.Range("A" & LiD)
    O.Range("K" & LiC).Copy OD.Range("M" & LiD) 'copie la plage K de CEl et la colle dans la colonne M de DEST
    O.Range("L" & LiC).Copy OD.Range("O" & LiD) 'copie la plage K de CEl et la colle dans la colonne M de DEST
    O.Range("M" & LiC).Copy OD.Range("R" & LiD) 'copie la plage K de CEl et la colle dans la colonne M de DEST
Next CEL 'prochaine cellule de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Où sont passées les "formules" ?

Le fichier :

 

[Ginou]

Re : [VBA - Résolu] Faire un copier coller avec un critère

Tu parles de formules excel ?

Merci Robert