Copie de données avec liaison entre 2 classeurs

cedana · 22 Août 2010

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😀")) 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

Guest · 23 Août 2010

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

cedana · 23 Août 2010

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😀")) 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+

cedana · 23 Août 2010

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

Re-bonjour Hasco.
Voici le fichier Asso.
A+

cedana · 23 Août 2010

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

Et enfin l'autre classeur.
Merci pour ton aide .

kjin · 23 Août 2010

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

Guest · 23 Août 2010

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

Bonjour,

@Kjin Permets toi, Permets-toi ....6h44 le café n'avait pas encore fait son effet😀

A++

kjin · 23 Août 2010

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

Re,
Tu ne vas pas le croire mais à la lecture de ta réponse, mes yeux se sont tout de suite portés sur l'heure du message 😀😀
A+
kjin

Guest · 23 Août 2010

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"😕

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 · 24 Août 2010

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.

Copie de données avec liaison entre 2 classeurs

cedana

XLDnaute Nouveau

Guest

Guest

cedana

XLDnaute Nouveau

cedana

XLDnaute Nouveau

Pièces jointes

cedana

XLDnaute Nouveau

Pièces jointes

kjin

XLDnaute Barbatruc

Guest

Guest

kjin

XLDnaute Barbatruc

Guest

Guest

cedana

XLDnaute Nouveau

Discussions similaires

Copie de données avec liaison entre 2 classeurs

cedana

XLDnaute Nouveau

Guest

Guest

cedana

XLDnaute Nouveau

cedana

XLDnaute Nouveau

Pièces jointes

cedana

XLDnaute Nouveau

Pièces jointes

kjin

XLDnaute Barbatruc

Guest

Guest

kjin

XLDnaute Barbatruc

Guest

Guest

cedana

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency