[XL-2010] Utilisation de la Fonction find [Résolu]

[tompom3108]

Bonjour à tous,

J'ai un classeur avec plusieurs feuilles qui chacunes peuvent avoir des lignes
dont les cellules sont identiques. Le problème c'est que chaque feuille fait l'objet d'un tri ou d'un filtre particulier et la présentation de chaque feuille change légèrement. Cela veut dire que les cellules identiques n'ont jamais les mêmes coordonnées... Or j'aimerai que les changements appliqués Feuil1 (par exemple) s'applique aux cellules identiques sur les autres feuilles.

Je voulais savoir si la fonction find était donc la plus adaptée pour ce type de problème. J'ai imaginé que je pourrai lire la feuil1 repérer les cellules cible et leur valeur, "scanner les autres feuilles et copier les valeurs des cellules de la Feuil1 sur celles des autres feuilles... Suis-je clair?

Enfin, merci d'avance pour vos réponse.

[Ormonth]

Bonjour,

le mieux ne serait-il pas que les cellules identiques des autres feuilles soient définies par formule d'égalité par rapport à la cellule référence de la feuille 1 ?

cordialement,

Didier

[tompom3108]

Bonjour Ormonth et merci pour ta réponse,

Pourquoi pas mais je ne vois pas comment cela marche comment on définit une formule d'égalité?

De mon côté j'ai commencé cela mais je bloque après le find

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Dim cible1 As String, cible2 As String
Dim rci As Range
 
Set Wbdest = ThisWorkbook
cible1 = Wbdest.Worksheets("P1").Cells(ligne, 2).Value
cible2 = Wbdest.Worksheets("P2").Cells(lignegm, 2).Value
cible1 = cible2
 
Wbdest.Worksheets("P1").Activate
 
For ligne = 25 To 1000
 
        Range(Cells(ligne, 1), Cells(ligne, 8)).Copy
 
    If IsEmpty(Cells(ligne, 1)) Then Exit For
    Next ligne
 
Wbdest.Worksheets("P2").Activate
 
For lignegm = 8 To 1000
 
If Find(What:=cible1, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).Address Then
 
 'comment selectionner la cellule contenant la cible1 trouvée pour coller la selection
 
Wbdest.Worksheets("P1").Range(Cells(ligne, 1), Cells(ligne, 8)).Paste
 
    End If
Next lignegm
 
 
End Sub

[Ormonth]

Bonjour,

dans toutes tes cellules dépendantes autres que source, tu as ce genre de formule :

Code :

=Feuil1!C6

Donc changements dynamiques en temps réel suivant options de calculs

cordialement,

Didier

[tompom3108]

rebonjour Didier,

Merci pour la réponse, cependant je ne comprends pas comment je peux appliquer ce que tu me dis c'est à dire

Code :

=Feuil1!C5

J'ai du mal m'exprimer au début. J'ai on va dire 8 colonnes dans une feuille 1 et les 8 mêmes dans une feuille 2 (mais pas sur les mêmes lignes car en tête différents). les valeurs changent régulièrement car j'ai un archivage de données d'un autre classeur qui ajoute des données donc des lignes et je tri dans les deux feuilles de manières différentes donc j'ai des données différentes et des données communes.

Ce que je voudrais, c'est que lorsque je modifie des valeurs de cellules manuellement feuil1, les changements s'effectue sur la feuille 2 si les données y sont présentes.

Donc je ne vois pas comment figer une égalité sur des cellules de feuilles différents pourrait m'aider...

Cordialement,
Thomas

[tompom3108]

Bon je fais des essais toujours pas concluant

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub cop()
 
Dim cible1 As String, cible2 As String
Dim rci As Range, rcic As Integer, lign As Integer, ligngm As Integer
 
 
Set Wbdest = ThisWorkbook
 
Wbdest.Worksheets("P1").Activate
 
For lign = 25 To 1000
 
cible1 = ThisWorkbook.Worksheets("P1").Cells(lign, 2).Value
 
        Range(Cells(lign, 1), Cells(lign, 8)).Copy
 
    If IsEmpty(Cells(lign, 1)) Then Exit For
 
Wbdest.Worksheets("P2").Activate
 
Set rci = Worksheets("P2").Columns("B:B").Find(What:=cible1, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).Address
 
For ligngm = 8 To 1000
 
If rci = True Then
 
rcic = rci.Row
 
ActiveCell = Cells(rcic, 1)
 
Wbdest.Worksheets("P1").Range(Cells(lign, 1), Cells(lign, 8)).Paste
    End If
Next ligngm
Next lign
 
 
End Sub

J'ai une erreur au niveau de :

Code :

Set rci = Worksheets("P2").Columns("B:B").Find(What:=cible1, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).Address

[gFZT82]

Bonjour,

Tu peux commencer avec ce code :
Pour chaque cellule de la colonne B de la feuille P1,
on recherche en colonne B de la feuille P2 une cellule qui a la même valeur.
Si on trouve, on copie la ligne de A à H de P1 en P2.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
Sub cop()
Dim Wbdest As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LigneDebut As Byte
Dim LigneFin As Long
Dim Cible1 As String
Dim Rci As Range, Lign As Integer
    Set Wbdest = ThisWorkbook
    Set Ws1 = Wbdest.Worksheets("P1")
    Set Ws2 = Wbdest.Worksheets("P2")
    LigneDebut = 25
    LigneFin = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
    'On balaye la colonne B de la feuille P1
    For Lign = LigneDebut To LigneFin
        'Valeur à rechercher : Cible1
        Cible1 = Ws1.Cells(Lign, 2).Value
        'Cherche la valeur dans la feuille P2, en colonne B
        Set Rci = Ws2.Columns(2).Find(What:=Cible1, LookAt:=xlPart)
        'Si on trouve
        If Not Rci Is Nothing Then
            'Copie la plage
            Ws1.Range(Ws1.Cells(Lign, 1), Ws1.Cells(Lign, 8)).Copy Destination:=Ws2.Range("A" & Rci.Row)
        End If
    Next Lign
    Set Wbdest = Nothing
    Set Ws1 = Nothing
    Set Ws2 = Nothing
End Sub

Cordialement.

[tompom3108]

Ok Merci gFZT82 je vais essayer ce code.