Copie de données avec liaison entre 2 classeurs

cedana

XLDnaute Nouveau
Bonsoir à tous.
Voici le sujet, je souhaite que des données saisies dans le classeur1 soient recopiées simultanément dans le classeur2 et sous conditions. Je vais essayer d'être clair. Les données du classeur1 des colonnes A,B,C,D,E,et F sont à recopier respectivement dans les colonnes A,C,D,F et E du classeur2 et à condition que les valeurs colonne C du classeur1 soient <> "Esp". Les plages de saisies pour les 2 classeurs s'étendent des lignes 7 à 85.
Voici ce que j'ai fait :
Sub maj()

Dim Asso As Workbook
Set Asso = GetObject("I:\Asso.xls")
Dim i As Long

For i = 7 To 85

If Workbooks("Classeur1").Sheets("Janv").Range("C" & i) <> "Esp" Then
Asso.Sheets("CCM").Range("A" & i) = Workbooks("Classeur1").Sheets("Janv").Range("A" & i)
Asso.Sheets("CCM").Range("C" & i) = Workbooks("Classeur1").Sheets("Janv").Range("B" & i)
Asso.Sheets("CCM").Range("D" & i) = Workbooks("Classeur1").Sheets("Janv").Range("C" & i)
Asso.Sheets("CCM").Range("E" & i) = Workbooks("Classeur1").Sheets("Janv").Range("F" & i)
Asso.Sheets("CCM").Range("F" & i) = Workbooks("Classeur1").Sheets("Janv").Range("E" & i)

End If
Next

End Sub
ça fonctionne ,mais il est évident que pour les valeurs = "Esp" j'ai des lignes blanches dans la feuille du classeur2 et pour éviter ce problème, je viens vous demander un peu d'aide.
Est-il possible d'associer ce bout de code avec le suivant:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim plage As Range
Set plage = Range("D" & Target.Row)

If Not Intersect(Target, Columns("D:D")) Is Nothing Then
If plage.Value >= 7000 And plage.Value < 8000 Then plage.Font.ColorIndex = 1
If plage.Value >= 7000 And plage.Value < 8000 Then Target.Offset(0, 1).Select
If plage.Value >= 6000 And plage.Value < 7000 Then plage.Font.ColorIndex = 3
If plage.Value >= 6000 And plage.Value < 7000 Then Target.Offset(0, 2).Select

End If

End Sub
 
G

Guest

Guest
Re : Copie de données avec liaison entre 2 classeurs

Bonjour et Bienvenue sur le forum,

Pour la question des lignes blanches, ceci devrait résoudre le problème:
Code:
    [COLOR=blue]Dim[/COLOR] Asso [COLOR=blue]As[/COLOR] Workbook
    [COLOR=blue]Set[/COLOR] Asso = GetObject([I]"I:\Asso.xls"[/I])
    [COLOR=blue]Dim[/COLOR] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], j [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]For[/COLOR] i = 7 To 85
        [COLOR=blue]If[/COLOR] Workbooks([I]"Classeur1"[/I]).Sheets([I]"Janv"[/I]).Range([I]"C"[/I] & i) <> [I]"Esp"[/I] [COLOR=blue]Then[/COLOR]
            [COLOR=blue]With[/COLOR] ass.Sheets([I]"CCM"[/I])
                [COLOR=green]'Prochaine cellule vide de la colonne A[/COLOR]
                j = .Range([I]"A"[/I] & .Rows.Count).[COLOR=blue]End[/COLOR](xlUp)(2).Row
                .Range([I]"A"[/I] & i) = Workbooks([I]"Classeur1"[/I]).Sheets([I]"Janv"[/I]).Range([I]"A"[/I] & i)
                .Range([I]"C"[/I] & i) = Workbooks([I]"Classeur1"[/I]).Sheets([I]"Janv"[/I]).Range([I]"B"[/I] & i)
                .Range([I]"D"[/I] & i) = Workbooks([I]"Classeur1"[/I]).Sheets([I]"Janv"[/I]).Range([I]"C"[/I] & i)
                .Range([I]"E"[/I] & i) = Workbooks([I]"Classeur1"[/I]).Sheets([I]"Janv"[/I]).Range([I]"F"[/I] & i)
                .Range([I]"F"[/I] & i) = Workbooks([I]"Classeur1"[/I]).Sheets([I]"Janv"[/I]).Range([I]"E"[/I] & i)
            [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]

Pour le deuxième point, je n'ai pas compris ce que tu cherches à faire.

Pour éditer des portions de code dans tes messages du forum utilise le bouton '#' de la barre d'édition. Cela les rendra plus lisibles.



A bientôt
 
Dernière modification par un modérateur:

cedana

XLDnaute Nouveau
Re : Copie de données avec liaison entre 2 classeurs

Bonjour Hasco et merci pour ta réponse très matinale.

Quelques précisions en ce qui concerne les 2 codes. En fait j'avais mis un code dans le classeur1 et l'autre dans le 2ème classeur , alors qu'il fallait les mettre dans le classeur1.
Ce que tu as fait fonctionne très bien, mais ça ne répond pas tout à fait à mon attente. Dès lors que les données col "C" du classeur1 = "Esp" il ne doit pas y avoir de lignes crées dans l'autre classeur. Voici le code:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)


Dim plage As Range
Set plage = Range("D" & Target.Row)

If Not Intersect(Target, Columns("D:D")) Is Nothing Then
If plage.Value >= 7000 And plage.Value < 8000 Then plage.Font.ColorIndex = 1
If plage.Value >= 7000 And plage.Value < 8000 Then Target.Offset(0, 1).Select
If plage.Value >= 6000 And plage.Value < 7000 Then plage.Font.ColorIndex = 3
If plage.Value >= 6000 And plage.Value < 7000 Then Target.Offset(0, 2).Select

End If

Dim Asso As Workbook
Set Asso = GetObject("I:\Asso.xls")
Dim i As Long, j As Long
For i = 7 To 85
If Workbooks("Classeur1").Sheets("Janv").Range("C" & i) <> "Esp" Then
With Asso.Sheets("CCM")
'Prochaine cellule vide de la colonne A
j = .Range("A" & .Rows.Count).End(xlUp)(1).Row
.Range("A" & i) = Workbooks("Classeur1").Sheets("Janv").Range("A" & i)
.Range("C" & i) = Workbooks("Classeur1").Sheets("Janv").Range("B" & i)
.Range("D" & i) = Workbooks("Classeur1").Sheets("Janv").Range("C" & i)
.Range("E" & i) = Workbooks("Classeur1").Sheets("Janv").Range("F" & i)
.Range("F" & i) = Workbooks("Classeur1").Sheets("Janv").Range("E" & i)
End With
End If
Next

End Sub

Pour une meilleure compréhension Je vais essayer de joindre les 2 classeurs
mais c'est pas gagné.
A+
 

kjin

XLDnaute Barbatruc
Re : Copie de données avec liaison entre 2 classeurs

Bonjour,
Si je peux me permettre
Code:
For i = 7 To 85
    If Workbooks("Classeur1").Sheets("Janv").Range("C" & i) <> "Esp" Then
        With Asso.Sheets("CCM")
            'Prochaine cellule vide de la colonne A
            [COLOR="Red"][SIZE="3"]j[/SIZE][/COLOR] = .Range("A" & .Rows.Count).End(xlUp)(1).Row
            .Range("A" & [B][COLOR="Red"][SIZE="3"]j[/SIZE][/COLOR][/B]) = Workbooks("Classeur1").Sheets("Janv").Range("A" & i)
sinon j ne sert à rien...
A+
kjin
 
G

Guest

Guest
Re : Copie de données avec liaison entre 2 classeurs

Re,

Voici le code réécrit:
Code:
   [COLOR=BLUE]Dim[/COLOR] Asso [COLOR=BLUE]As[/COLOR] Workbook, shSource [COLOR=BLUE]As[/COLOR] Worksheet, shDest [COLOR=BLUE]As[/COLOR] Worksheet
    [COLOR=BLUE]Set[/COLOR] Asso = GetObject([i]"I:\Asso.xls"[/i])
    [COLOR=BLUE]Set[/COLOR] shSource = ThisWorkbook.Sheets([i]"Janv"[/i])
    [COLOR=BLUE]Set[/COLOR] shDest = Asso.Sheets([i]"CCM"[/i])
    [COLOR=BLUE]Dim[/COLOR] i [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Long[/COLOR], j [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Long[/COLOR]
    [COLOR=BLUE]For[/COLOR] i = 7 To 85
        [COLOR=BLUE]If[/COLOR] shSource.Range([i]"C"[/i] & i) <> [i]""[/i] [COLOR=BLUE]And[/COLOR] shSource.Range([i]"C"[/i] & i) <> [i]"Esp"[/i] [COLOR=BLUE]Then[/COLOR]
            [COLOR=BLUE]With[/COLOR] shDest
                [COLOR=GREEN]'Prochaine cellule vide de la colonne A[/COLOR]
                j = .Range([i]"A"[/i] & .Rows.Count).[COLOR=BLUE]End[/COLOR](xlUp)(2).Row
                [COLOR=BLUE]If[/COLOR] j < 7 [COLOR=BLUE]Then[/COLOR] j = 7
                .Range([i]"A"[/i] & j) = shSource.Range([i]"A"[/i] & i)
                .Range([i]"C"[/i] & j) = shSource.Range([i]"B"[/i] & i)
                .Range([i]"D"[/i] & j) = shSource.Range([i]"C"[/i] & i)
                .Range([i]"E"[/i] & j) = shSource.Range([i]"F"[/i] & i)
                .Range([i]"F"[/i] & j) = shSource.Range([i]"E"[/i] & i)
            [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]With[/COLOR]
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
    [COLOR=BLUE]Next[/COLOR]

Mais si tu mets ceci dans
Code:
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Worksheet_Change([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Range)

Dès qu'il y aura un changement sur ta feuille, il y aura réécritures dans Asso des lignes 7 à 85 pour lesquelles C est différent de vide ou "Esp":confused:

Je le placerai plutôt dans une macro que j'appelerai en temps voulu.

Même en contraignant à la colonne C et en écrivant qu'une seule ligne dans Asso, tu finiras par avoir des doublons dans Asso.

Je réitère ce que je te disais plus haut à savoir utilise la balise '#' de l'éditeur de message dans tes posts.

A+
 

cedana

XLDnaute Nouveau
Re : Copie de données avec liaison entre 2 classeurs

Bonjour Hasco.
Je vais suivre ton conseil, je vais mettre ce code dans une macro que je lancerai pour mettre à jour le classeur "Asso".
Je te remercie beaucoup de ton aide, et à bientôt sur le forum.
 

Discussions similaires

Réponses
12
Affichages
537
Réponses
14
Affichages
621

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla