Copier Coller des valeurs avec condition dans un autre classeur

Bonjour,

je suis débutant en macro excel.

Je bloque sur la création d'une macro pour faire simple :

Dans mon classeur "03 - Aluminium", il y a une macro qui récupère les données de toute les feuilles crées et qui les stocks dans la feuille "Accueil" grâce au bouton "Mise à Jour".

Je souhaite que mes cellules D,E,F,M,I ( voir schéma ) de cette ligne de la feuille "Accueil" soit copiés, si leurs colonne validation est égal à "OK". Si la conditions est validée, alors il colle les lignes dans la dernière ligne disponible dans l'autre classeur "03 - MAJ DES STANDARD VITESSE ET ABRASIF".

capture 23 07 19 09 20 02

Attention, la colonne machine de la feuille "Accueil" du classeur "03 - Aluminium" doit permettre de copier les cellules dans la bonne feuille destination du classeur.

( Exemple si la colonne machine de la feuille "Accueil" du classeur "03 - Aluminium" est égal à D3 4000 à 2 têtes ou 3000 buse de 14 alors il faut qu'il colle les valeurs dans la feuille D3 3000 buse de 14 du classeur "03 - MAJ DES STANDARD VITESSE ET ABRASIF".

Je suis également limité par la version 32 bits d'excel.

Merci d'avance pour votre aide

5303-aluminium.xlsm (26.50 Ko)

Bonpour AF, bonjour le forum,

Attention, la colonne machine de la feuille "Accueil" du classeur "03 - Aluminium" doit permettre de copier les cellules dans la bonne feuille destination du classeur.

( Exemple si la colonne machine de la feuille "Accueil" du classeur "03 - Aluminium" est égal à D3 4000 à 2 têtes ou 3000 buse de 14 alors il faut qu'il colle les valeurs dans la feuille D3 3000 buse de 14 du classeur "03 - MAJ DES STANDARD VITESSE ET ABRASIF".

Trop aléatoire pour coder. Il faut que tous les onglets aient le même tableau (ce qui n'est pas le cas) et surtout le même nom que la valeur indiquée dans la colonne C...

Même si je change le nom des onglets, cela ne fonctionnera pas ?

Re,

Si, si il les noms concordent, ça peut marcher. On peut même demander à la macro de créer un ongle si celui-ci n'existe pas...

Je vais changer le nom des onglets et le bon tableau est celui de la D3 3000 buse de 14 tout les onglet seront comme celui ci (1ère image).

Re,

Ok ! Alors envoie le fichier exactement comme il doit être...

Voici les fichiers modifiés avec les onglets identiques que la colonne machine.

5503-aluminium.xlsm (27.35 Ko)

Re,

Essai avec ce code à attribuer au bouton Mise à jour :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim LR As Integer 'déclare la variable LR (Ligne de Référence)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Accueil") 'définit l'onglet source OS)
TV = OS.Range("A3").CurrentRegion 'définit le tableau des valeurs TV
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe a la ligne suivante)
Set CD = Workbooks("03 - MAJ DES STANDARD VITESSE ET ABRASIF.xlsm") 'définit le classeur destination (génère une erreur si le fichier mn'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    MsgBox "Vous devez ouvrir le classeur 03 - MAJ DES STANDARD VITESSE ET ABRASIF.xlsm !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If UCase(TV(I, 15)) = "OK" Then 'si la donnée ligne I colonne 15 de TV vaut OK
        Set OD = CD.Worksheets(TV(I, 3)) 'définit l'onglet destination OD (donnée ligne I colonne 3 de TV)
        LR = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1 'définit la ligne de référence LR de la colonne B de l'onglet OD
        OD.Cells(LR, "B").Value = TV(I, 4) 'renvoie dans la cellule ligne LR colonne B de l'onglet OD la donnée en ligne I colonne 4 de TV
        OD.Cells(LR, "C").Value = TV(I, 5) 'renvoie dans la cellule ligne LR colonne C de l'onglet OD la donnée en ligne I colonne 5 de TV
        OD.Cells(LR, "D").Value = TV(I, 6) 'renvoie dans la cellule ligne LR colonne D de l'onglet OD la donnée en ligne I colonne 6 de TV
        OD.Cells(LR, "F").Value = TV(I, 13) 'renvoie dans la cellule ligne LR colonne F de l'onglet OD la donnée en ligne I colonne 13 de TV
        OD.Cells(LR, "K").Value = TV(I, 9) 'renvoie dans la cellule ligne LR colonne K de l'onglet OD la donnée en ligne I colonne 9 de TV
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

le code fonctionne super bien merci.

Par contre cela à généré un défaut que je n'avais pas prévue, les doublons.

y'a t-il un moyen de lorsque j'importe les données qu'il importe uniquement les nouvelles données?

8203-aluminium.xlsm (31.64 Ko)

Re,

Une solution simple serait de supprimer le OK ou de le remplacer par OK D (OK Déplacé). De cette manière lors du prochain lancement de la macro, la ligne se sera plus prise en compte :

Le code à adapter :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim LR As Integer 'déclare la variable LR (Ligne de Référence)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Accueil") 'définit l'onglet source OS)
TV = OS.Range("A3").CurrentRegion 'définit le tableau des valeurs TV
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe a la ligne suivante)
Set CD = Workbooks("03 - MAJ DES STANDARD VITESSE ET ABRASIF.xlsm") 'définit le classeur destination (génère une erreur si le fichier mn'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    MsgBox "Vous devez ouvrir le classeur 03 - MAJ DES STANDARD VITESSE ET ABRASIF.xlsm !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If UCase(TV(I, 15)) = "OK" Then 'si la donnée ligne I colonne 15 de TV vaut OK

        **********************
        à adapter au-dessous
        **********************
    OS.Cells(I+2,"O").Value="OK D" 'pour renmplacer le "OK" par "OK D"
    'ou
    'OS.Cells(I+2, "O").Value="" 'pour supprimer le OK

        *********************
        à adapter au-dessus
        *********************
        Set OD = CD.Worksheets(TV(I, 3)) 'définit l'onglet destination OD (donnée ligne I colonne 3 de TV)
        LR = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1 'définit la ligne de référence LR de la colonne B de l'onglet OD
        OD.Cells(LR, "B").Value = TV(I, 4) 'renvoie dans la cellule ligne LR colonne B de l'onglet OD la donnée en ligne I colonne 4 de TV
        OD.Cells(LR, "C").Value = TV(I, 5) 'renvoie dans la cellule ligne LR colonne C de l'onglet OD la donnée en ligne I colonne 5 de TV
        OD.Cells(LR, "D").Value = TV(I, 6) 'renvoie dans la cellule ligne LR colonne D de l'onglet OD la donnée en ligne I colonne 6 de TV
        OD.Cells(LR, "F").Value = TV(I, 13) 'renvoie dans la cellule ligne LR colonne F de l'onglet OD la donnée en ligne I colonne 13 de TV
        OD.Cells(LR, "K").Value = TV(I, 9) 'renvoie dans la cellule ligne LR colonne K de l'onglet OD la donnée en ligne I colonne 9 de TV
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

salut, thautheme le code fonctionne comme il devrais merci.

Rechercher des sujets similaires à "copier coller valeurs condition classeur"