Copier Données D'un Classeur à Un Autre (Par Couleur)

Le 21/07/2016 à 17:01

Bonjour,

je cherche à copier les données de la colonne Q de l'onglet MO 1 (classeur : Ven 1) vers la colonne Q de l'onglet MO 2 (classeur : Ven 2) mais à condition ne copier que les données des celules qui sont en jaune et en vert

Merci

13ven.zip (60.50 Ko)
Le 21/07/2016 à 17:07

Bonjour DonMunnir, bonjour le forum,

Super exemple avec aucune donnée en colonne Q !.... Et tout en vert... Tu aurais pu au moins faire l'effort de fournir un exemple avec des données exploitables...

Le 21/07/2016 à 17:11

Bonjour Thauthème,

j'ai retéléchargé le fichier, merci pour le rappel

Le 21/07/2016 à 18:19

quelqu'un pourrait me faire une proposition ?

Le 22/07/2016 à 08:24

Aidez moi s'il vous plait

Le 22/07/2016 à 10:51

Bonjour DonMunnir, bonjour le forum,

Oui ! On va t'aider mais nous ne sommes que des bénévoles et on est pas aux pièces !...

Pourquoi as tu spécifier deux couleurs alors que dans ton exemple il n'y en a qu'une seule dans la colonne Q ?

[Édition]

Ooops ! Pardon, je viens de comprendre... Je t'envoie une proposition dès que j'ai fini et testé...

Le 22/07/2016 à 11:25

Re,

Le code ci-dessous, à placer, dans le classeur ven 1.xlsx qui, par deviendra donc ven 1.xlsm à cause de la macro.

Il faut que les deux classeurs soient ouverts ou, si ce n'est pas le cas, qu'il soient enregistrés dans le même dossier...

Le code :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim OS As Worksheet 'déclare la variable CS (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 DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)

Set CS = ThisWorkbook 'définit le classeur source CS
CH = CS.Path & "\" 'définit le chemin d'accès CH
Set OS = CS.Worksheets("MO 1") 'définit l'onglet source CS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("ven 2.xlsx") 'définit le classeur source CS (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Workbooks.Open (CH & "ven 2.xlsx") 'ouvre le classeur ""ven 2.xlsx"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Worksheets("MO 2") 'définit l'onglet destination OD
DL = OS.Range("Q" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne Q de l'onglet OS
For I = 13 To DL 'boucle sur les lignes 13 à DL
    'si la cellule ligne I, colonne 17 (=Q) de l'onglet OS n'est pas vide et si il a la couleur vert ou jaune
    If OS.Cells(I, 17).Value <> "" And OS.Cells(I, 17).Interior.Color = 65535 Or OS.Cells(I, 17).Interior.Color = 11073710 Then
        OD.Cells(I, 17).Value = OS.Cells(I, 17).Value 'récupère dans la cellule ligne I, colonne 17 (=Q) de l'onglet OD, la valeur de la cellule ligne I, colonne 17 (=Q) de l'onglet OS
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

Le fichier :

10ven-1.xlsm (43.87 Ko)
Le 22/07/2016 à 11:34

Bonjour ThauThème,

merci pour le code il marche comme je souhaitais sauf que le classeur ven2 qui doit être ouvert et doit comporter le code pour importer les données de ven1 sans l'ouvrir

Le 22/07/2016 à 11:59

Re,

Non !... Je me suis mal exprimé :

  • Soit les deux classeur sont enregistré tous les deux dans le même dossier et là, le classeur contenant le code : ven 1.xlsm doit être impérativement ouvert (pour lancer la macro, œuf Corse !...). Et,si les deux sont ouverts, ça marche quand même...
  • Sinon, les deux doivent être impérativement ouverts si ils ne sont pas enregistrés dans un même dossier.
Mais en aucun cas ven 2.xlsx ne doit comporter le code !...

Je te signale qu'à aucun moment dans ta requête tu fais allusion à l'ouverture ou non des classeurs !... Je suis surpris que tu t'en plaignes maintenant

Re,

DonMunnir a écrit :

Bonjour ThauThème,

merci pour le code il marche comme je souhaitais sauf que le classeur ven2 qui doit être ouvert et doit comporter le code pour

importer les données de ven1 sans l'ouvrir

Je viens de comprendre tu as oublier le c'est... c'est le classeur ven2 qui doit.... Tu n'étais pas obligé d'aller sur un autre forum, tu sais (pas très éthique). J'aurais pu modifier le code.

Pas foutu d'exprimer correctement ta requête mais ça râle dès que la réponse n'est pas immédiate ! Ça ne m'étonne pas finalement...

Le 23/07/2016 à 10:03

Bonjour DonMunnir, bonjour le forum,

Je revois ma position, suite à ton mail perso. Pour un étranger, je te félicite pour l'effort que tu fait en écriture. Beaucoup de français n'en font pas autant...

J'ai inversé le code qui doit maintenant être placé dans le classeur ven 2.xlsx, mais le problème reste identique, il faut que les deux fichiers soient enregistrés dans le même dossier. Autre chose, sans ouvrir le fichier source je ne sais pas faire (une histoire d'ADO et j'ai passé l'âge...). Le fichier est ouvert, les données sont récupérées et le classeur est refermé. C'est pratiquement transparent...

Le code à placer dans le classeur qui s'appellera désormais : ven 2.xlsm :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable CS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CH = CS.Path & "\" 'définit le chemin d'accès CH
Set OD = CD.Worksheets("MO 2") 'définit l'onglet destination OD
Set CS = Workbooks.Open(CH & "ven 1.xlsx") 'ouvre le classeur "ven 1.xlsx"
Set OS = CS.Worksheets("MO 1") 'définit l'onglet source OS
DL = OS.Range("Q" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne Q de l'onglet source OS
For I = 13 To DL 'boucle sur les lignes 13 à DL
    'si la cellule ligne I, colonne 17 (=Q) de l'onglet OS n'est pas vide et si il a la couleur vert ou jaune
    If OS.Cells(I, 17).Value <> "" And OS.Cells(I, 17).Interior.Color = 65535 Or OS.Cells(I, 17).Interior.Color = 11073710 Then
        'récupère dans la cellule ligne I, colonne 17 (=Q) de l'onglet OD, la valeur de la cellule ligne I, colonne 17 (=Q) de l'onglet OS
        OD.Cells(I, 17).Value = OS.Cells(I, 17).Value
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
CD.Save 'enregistre le classeur destination
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
Le 23/07/2016 à 10:53

Bonjour Thauthème,

merci pour ta compéhension

cette fois ci le code beug dans la ligne de définition du chemin d'accès, même en mettant les deux classeurs dans le même dossier

CH = CS.Path & "\" 'définit le chemin d'accès CH

ci-joint le fichier

7vene.zip (69.20 Ko)
Le 23/07/2016 à 11:27

Re,

Oui pardon, j'ai oublié de modifier cette ligne ! Il faut écrire :

CH = CD.Path & "\"
Le 23/07/2016 à 12:44

Merci Beaucoup Thauthème c'est exactement ce que je cherchais

maintenant est ce qu'on peut crèer un autre bouton qui efface les données qu'on a importé???

Merci d'avance

Le 23/07/2016 à 13:39

Re,

Remplace le code par :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable CS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CH = CS.Path & "\" 'définit le chemin d'accès CH
Set OD = CD.Worksheets("MO 2") 'définit l'onglet destination OD
Set CS = Workbooks.Open(CH & "ven 1.xlsx") 'ouvre le classeur "ven 1.xlsx"
Set OS = CS.Worksheets("MO 1") 'définit l'onglet source OS
DL = OS.Range("Q" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne Q de l'onglet source OS
For I = 13 To DL 'boucle sur les lignes 13 à DL
    'si la cellule ligne I, colonne 17 (=Q) de l'onglet OS n'est pas vide et si il a la couleur vert ou jaune
    If OS.Cells(I, 17).Value <> "" And OS.Cells(I, 17).Interior.Color = 65535 Or OS.Cells(I, 17).Interior.Color = 11073710 Then
        'récupère dans la cellule ligne I, colonne 17 (=Q) de l'onglet OD, la valeur de la cellule ligne I, colonne 17 (=Q) de l'onglet OS
        OD.Cells(I, 17).Value = OS.Cells(I, 17).Value
        OS.Cells(I, 17).Value = "" 'efface la donnée source
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
CS.Close True 'ferme le classeur source en enregistrant les modifications
CD.Save 'enregistre le classeur destination
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
Le 24/07/2016 à 14:17

Bonjour thauthème

merci beaucoup c'est ce que je voulais

Rechercher des sujets similaires à "copier donnees classeur couleur"