Copie d'une feuille à l'autre

[hestiahv]

Bonjour,

J’éprouve un petit problème avec le présent code qui fut fait dans le but de copier d’une feuille à l’autre des données. En entrant une donnée en A15, si elle ce retrouve dans la FEUILLE 2, l’information relié à cette dernière ce copiera en FEUILLE 1.

Le tout fonctionne à 100% sauf quand je tente d’y ajouter la FEUILL 3.

L’info apparait et disparait aussi tôt.

Je tiens à remercier grandement FredOo pour ce code efficace.

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("a15:a59"))
If Target Is Nothing Then Exit Sub
Target.Offset(, 1).FormulaR1C1 = "=IF(COUNTIF(Feuil2!C1:C8,RC[-1]),VLOOKUP(RC[-1],Feuil2!C1:C8,2,0),"""")"
Target.Offset(, 1) = Target.Offset(, 1).Value 'remplace la formule par la valeur
Target.Offset(, 13).FormulaR1C1 = "=IF(COUNTIF(Feuil2!C1:C8,RC[-13]),VLOOKUP(RC[-13],Feuil2!C1:C8,5,0),"""")"
Target.Offset(, 13) = Target.Offset(, 13).Value 'remplace la formule par la valeur
Target.Offset(, 14).FormulaR1C1 = "=IF(COUNTIF(Feuil2!C1:C8,RC[-14]),VLOOKUP(RC[-14],Feuil2!C1:C8,3,0),"""")"
Target.Offset(, 14) = Target.Offset(, 14).Value 'remplace la formule par la valeur

Target.Offset(, 1).FormulaR1C1 = "=IF(COUNTIF(Feuil3!C1:C8,RC[-1]),VLOOKUP(RC[-1],Feuil3!C1:C8,2,0),"""")"
Target.Offset(, 1) = Target.Offset(, 1).
Target.Offset(, 13).FormulaR1C1 = "=IF(COUNTIF(Feuil3!C1:C8,RC[-13]),VLOOKUP(RC[-13],Feuil3!C1:C8,5,0),"""")"
Target.Offset(, 13) = Target.Offset(, 13).
Target.Offset(, 14).FormulaR1C1 = "=IF(COUNTIF(Feuil3!C1:C8,RC[-14]),VLOOKUP(RC[-14],Feuil3!C1:C8,3,0),"""")"
Target.Offset(, 14) = Target.Offset(, 14).Value 'remplace la formule par la valeur
End Sub

 

[JNP]

Re : Copie d'une feuille à l'autre

Bonsoir Hestiahv 🙂,
C'est un peu normal, tu écris dans les cellules le résultat de la recherche sur la feuille 2, puis tu les écrases avec les résultats de la feuille 3 😛...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Feuille As Worksheet, Résultat As Range
Set Target = Intersect(Target, Range("a15:a59"))
If Target Is Nothing Then Exit Sub
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> "Feuil1" Then
Set Résultat = Feuille.Columns(1).Find(What:=Target.Value, LookAt:=xlWhole)
If Not Résultat Is Nothing Then
Target.Offset(0, 1) = Résultat.Offset(0, 1)
[COLOR=blue]Target.Offset(0, 13) = Résultat.Offset(0, 2)[/COLOR]
[COLOR=blue]Target.Offset(0, 14) = Résultat.Offset(0, 3)[/COLOR]
Exit Sub
End If
End If
Next
End Sub

devrait mieux fonctionner, en modifiant les offset suivant tes souhaits (j'ai pas tout suivi de tes colonnes 🙄).
Bonne soirée 😎

 

[kjin]

Re : Copie d'une feuille à l'autre

Bonsoir,

Le tout fonctionne à 100% sauf quand je tente d’y ajouter la FEUILL 3.

J'ai qq doutes

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("a15:a59")) Is Nothing Or Target = "" Then Exit Sub
Set rng = Sheets("Feuil2").Columns(1).Find(Target)
    If rng Is Nothing Then
    Set rng = Sheets("Feuil3").Columns(1).Find(Target)
    End If
    If Not rng Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(, 1) = rng.Offset(, 1)
        Target.Offset(, 13) = rng.Offset(, 2)
        Target.Offset(, 14) = rng.Offset(, 3)
        Application.EnableEvents = True
    End If
End Sub

Edit : Bonsoir JNP

A+
kjin

 

[hestiahv]

Re : Copie d'une feuille à l'autre

Bien le bon soir au fil,

Il serait facile de juste copier le tout mais je ne serai pas avancé car je dois ajouter 12 page de recherhce au total.

Pourquoi 12 pages? Car ma recherche ce dois de comparer avec 765 000 mile donnée différente. Étant donné qu'un maximum de 65 586 données est toléré par feuille, j'ai divisé mes donnée en 12 page d'environ 65 000.

Je alors répéter le code de FredOo, et/ou un autre code, qui me permaiterais de ne pas perde l'information.....du à l'écrasement.

Une idée?

Si l'un de vos code si-haut pourrais m'aider, j'aimerais bien me le faire décortiquer pour que je puisse le comprendre. Celui de FredOo était visuellement facil à comprendre pour quelqu'un comme moi.....PEU EXPIRIMEBTÉ

Hestia

 

[kjin]

Re : Copie d'une feuille à l'autre

Re,
Oubli mon code puisqu'il ne cherche que dans les feuil2 et feuil3.
A l'inverse, le code de JNP fait une recherche dans la colonne A de toutes les feuilles du classeur, sauf la feuil1
A+
kjin

 

[hestiahv]

Re : Copie d'une feuille à l'autre

Bonjour à tous,

Ne travaillez pas pour rien, j'ai vraiment pris le temps de lire, et j'ai compris le code de KJin

Je tiens à dire que je suis fort impressionné du support...

Merci......

Hestia

 

[JNP]

Re : Copie d'une feuille à l'autre

Re 🙂,
Effectivement, je m'étais douté que la feuille 3 ne serait pas la dernière 😉.
Par contre, 2 tests de Kjin mériterait d'être incorporés dans mon code pour éviter les plantages

If Target.Count > 1 Then Exit Sub
Or Target = ""

ce qui donne

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Feuille As Worksheet, Résultat As Range
[COLOR=red][B]If Target.Count > 1 Then Exit Sub[/B][/COLOR]
Set Target = Intersect(Target, Range("a15:a59"))
If Target Is Nothing [COLOR=red][B]Or Target = ""[/B][/COLOR] Then Exit Sub
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> "Feuil1" Then
Set Résultat = Feuille.Columns(1).Find(What:=Target.Value, LookAt:=xlWhole)
If Not Résultat Is Nothing Then
Target.Offset(0, 1) = Résultat.Offset(0, 1)
[COLOR=blue]Target.Offset(0, 13) = Résultat.Offset(0, 2)[/COLOR]
[COLOR=blue]Target.Offset(0, 14) = Résultat.Offset(0, 3)[/COLOR]
Exit Sub
End If
End If
Next
End Sub

Bonne journée 😎