Recherche de Valeur d'un onglet sur un autre pour copie en VBA

A

Arno94

XLDnaute Nouveau
Bonjour, Bonjour,

J’espère que tout le monde va bien, pour ma part je patauge vraiment sur un problème de recherche de valeur et copie de donnée dans des cellules présentes dans la ligne ou la valeur à été trouvée en VBA, donc j’en appel à votre aide qui m’a toujours été d’un grand secours.

Je vous expose mon problème :

J’ai donc un onglet nommé « donnée » qui lui contient toutes les données de la cellule A3 à TX (en fonction de ce qui à été importer dedans.

A partir de "A3" onglet « donnée » j’ai des codes qui sont présents soit dans mon onglet Local (colonne AG) ou dans mon onglet Gaine (colonne W)

J’aimerais qu’il prenne la première valeur (A3) et qu’il regarde dans l’onglet local (colonne AG) s’il existe, si il est présent copier les données contenu dans l’onglet « donnée » par exemple B3 (dans notre cas) en MX(en fonction de la ou il à trouvé la cellule)

S’il ne le trouve pas dans l’onglet local, qu’il passe dans l’onglet gaine pour voir s’il y est, s’il y est il copie la cellule (B3) dans la colonne MX (en fonction de la ou il l’a trouvée)

S’il ne la trouve pas il faudrait qu’il mette par exemple un X en colonne UX sur mon onglet de donnée afin de marquer qu’il ne la pas trouvé.

Ensuite il passe à la cellule du dessous il refait la même chose jusqu'à le derniere cellule rempli de la colonne A de mon onglet "donnée".

Bien sur je ne donne qu’un exemple sur une donnée à copier mais j’en ai pas mal…. Et pas mal de code également.

Est-ce que quelqu’un aurait une petite idée pour me venir en aide :)

Merci d’avance

Arno
 

Pièces jointes

  • Copie de BCT-01-001-00-R01.zip
    175.5 KB · Affichages: 51
Dernière édition:
Trier par date Trier par votes
A

Arno94

XLDnaute Nouveau
Re : Recherche de Valeur d'un onglet sur un autre pour copie en VBA

Bonjour :)

Merci je regarde de suite :)

Edit 2 : C'est pas grave si dans mon onglet "donnée" j'ai des lignes vides?


Edit :

Cela marche pour les locaux mais pas pour les gaines...

Je vais regarder de plus prêt pour essayer de comprendre le code et l'adapter à mes besoins :)

Et reviendrais le mettre ici (enfin si j'y arrive)

Merci :)


Edit 3 : Je suis une buse c'est officiel.... j'ai compris pourquoi cela ne marchait pas pour les gaines... il n'y avait rien dans la colonne B ...

Ca marche du tonerre, je commente le code, l'incremente pour mon usage et reviens le posté.

Merci Enormement
 
Dernière édition:
Vote positif 0 Vote négatif
A

Arno94

XLDnaute Nouveau
Re : Recherche de Valeur d'un onglet sur un autre pour copie en VBA

Bonjour, merci beaucoup cela marche nickel :)

Je l'ai adapté pour deux types de fichiers

Voici les deux codes (si cela peut aider d'autre personne)

Pour le fichier joint plus haut :

Sub Transfert()
Dim Cell As Range
Dim myVar As Long

With Sheets("Données") 'Avec l'onglet données
For Each Cell In .Range("A3:A" & .Range("A65536").End(xlUp).Row)
'Pour toutes les cell dans la plage A3 jusqu'à la derniere

On Error Resume Next
myVar = 0 '???
myVar = Application.WorksheetFunction _
.Match(Cell, Worksheets("Injectionbloclocal").Range("AG1:AG10000"), 0)
On Error GoTo 0
If myVar <> 0 Then 'Si Myvar est differente de 0 alors :

'Définition des correspondances Local
Worksheets("Injectionbloclocal").Cells(myVar, 13) = Cell.Offset(0, 1) 'Code Ancien
Worksheets("Injectionbloclocal").Cells(myVar, 14) = Cell.Offset(0, 2) 'Nom d'usage
Worksheets("Injectionbloclocal").Cells(myVar, 15) = Cell.Offset(0, 3) 'Nom normalisé
Worksheets("Injectionbloclocal").Cells(myVar, 16) = Cell.Offset(0, 4) 'SECTEUR_ACTIVITE
Worksheets("Injectionbloclocal").Cells(myVar, 17) = Cell.Offset(0, 5) 'SOUS_SECTEUR_ACTIVITE
Worksheets("Injectionbloclocal").Cells(myVar, 18) = Cell.Offset(0, 6) 'CODE_UG
Worksheets("Injectionbloclocal").Cells(myVar, 19) = Cell.Offset(0, 7) 'CODE_UA
Worksheets("Injectionbloclocal").Cells(myVar, 20) = Cell.Offset(0, 8) 'OCCUPANT_EXTERNE
Worksheets("Injectionbloclocal").Cells(myVar, 21) = Cell.Offset(0, 9) 'CODE_POLE
Worksheets("Injectionbloclocal").Cells(myVar, 22) = Cell.Offset(0, 10) 'SERVICE
Worksheets("Injectionbloclocal").Cells(myVar, 23) = Cell.Offset(0, 11) 'DISPONIBILITE
Worksheets("Injectionbloclocal").Cells(myVar, 24) = Cell.Offset(0, 12) 'ACCES_HANDICAPES
Worksheets("Injectionbloclocal").Cells(myVar, 25) = Cell.Offset(0, 13) 'SURFACE
Worksheets("Injectionbloclocal").Cells(myVar, 26) = Cell.Offset(0, 14) 'HSP
Worksheets("Injectionbloclocal").Cells(myVar, 27) = Cell.Offset(0, 15) 'HSFP
Worksheets("Injectionbloclocal").Cells(myVar, 28) = Cell.Offset(0, 16) 'VOLUME
Worksheets("Injectionbloclocal").Cells(myVar, 29) = Cell.Offset(0, 17) 'RISQUE_LABORATOIRE
Worksheets("Injectionbloclocal").Cells(myVar, 30) = Cell.Offset(0, 18) 'AMIANTE
Worksheets("Injectionbloclocal").Cells(myVar, 31) = Cell.Offset(0, 19) 'NATURE_SOL



ElseIf myVar = 0 Then 'par contre si ell est egale à 0

On Error Resume Next
' Gaine
myVar = 0
myVar = Application.WorksheetFunction _
.Match(Cell, Worksheets("Injectionblocgaine").Range("W1:W10000"), 0)
On Error GoTo 0
If myVar <> 0 Then



Worksheets("Injectionblocgaine").Cells(myVar, 13) = Cell.Offset(0, 1) 'Code Ancien
Worksheets("Injectionblocgaine").Cells(myVar, 14) = Cell.Offset(0, 2) 'Nom d'usage
Worksheets("Injectionblocgaine").Cells(myVar, 15) = Cell.Offset(0, 3) 'Nom normalisé
Worksheets("Injectionblocgaine").Cells(myVar, 16) = Cell.Offset(0, 4) 'SECTEUR_ACTIVITE
Worksheets("Injectionblocgaine").Cells(myVar, 17) = Cell.Offset(0, 5) 'SOUS_SECTEUR_ACTIVITE
Worksheets("Injectionblocgaine").Cells(myVar, 18) = Cell.Offset(0, 6) 'SURFACE
Worksheets("Injectionblocgaine").Cells(myVar, 19) = Cell.Offset(0, 7) 'CODE_UG
Worksheets("Injectionblocgaine").Cells(myVar, 20) = Cell.Offset(0, 8) 'CODE_POLE
Worksheets("Injectionblocgaine").Cells(myVar, 21) = Cell.Offset(0, 9) 'AMIANTE


ElseIf myVar = 0 Then
Cell.Offset(0, 20) = "X"
End If
End If
Next
End With
End Sub


Et pour un fichier (donnée) different :

Sub Transfert()
Dim Cell As Range
Dim myVar As Long

With Sheets("Données") 'Avec l'onglet données
For Each Cell In .Range("A3:A" & .Range("A65536").End(xlUp).Row)
'Pour toutes les cell dans la plage A3 jusqu'à la derniere

On Error Resume Next
myVar = 0 '???
myVar = Application.WorksheetFunction _
.Match(Cell, Worksheets("Injectionbloclocal").Range("AG1:AG10000"), 0)
On Error GoTo 0
If myVar <> 0 Then 'Si Myvar est differente de 0 alors :

'Définition des correspondances Local
Worksheets("Injectionbloclocal").Cells(myVar, 13) = Cell.Offset(0, 2) 'Code Ancien
Worksheets("Injectionbloclocal").Cells(myVar, 14) = Cell.Offset(0, 4) 'Nom d'usage
Worksheets("Injectionbloclocal").Cells(myVar, 15) = Cell.Offset(0, 5) 'Nom normalisé
Worksheets("Injectionbloclocal").Cells(myVar, 16) = Cell.Offset(0, 6) 'SECTEUR_ACTIVITE
Worksheets("Injectionbloclocal").Cells(myVar, 17) = Cell.Offset(0, 7) 'SOUS_SECTEUR_ACTIVITE
Worksheets("Injectionbloclocal").Cells(myVar, 18) = Cell.Offset(0, 10) 'CODE_UG Affectation
Worksheets("Injectionbloclocal").Cells(myVar, 23) = Cell.Offset(0, 11) 'Disponibilité
Worksheets("Injectionbloclocal").Cells(myVar, 24) = Cell.Offset(0, 12) 'Handi
Worksheets("Injectionbloclocal").Cells(myVar, 25) = Cell.Offset(0, 15) 'Surface
Worksheets("Injectionbloclocal").Cells(myVar, 26) = Cell.Offset(0, 17) 'HSP
Worksheets("Injectionbloclocal").Cells(myVar, 27) = Cell.Offset(0, 18) 'HSFP
Worksheets("Injectionbloclocal").Cells(myVar, 29) = Cell.Offset(0, 21) 'RISQUE_LABORATOIRE
Worksheets("Injectionbloclocal").Cells(myVar, 30) = Cell.Offset(0, 22) 'AMIANTE
Worksheets("Injectionbloclocal").Cells(myVar, 31) = Cell.Offset(0, 25) 'NATURE_SOL

ElseIf myVar = 0 Then 'par contre si ell est egale à 0

On Error Resume Next
' Gaine
myVar = 0
myVar = Application.WorksheetFunction _
.Match(Cell, Worksheets("Injectionblocgaine").Range("W1:W10000"), 0)
On Error GoTo 0
If myVar <> 0 Then





Worksheets("Injectionblocgaine").Cells(myVar, 13) = Cell.Offset(0, 2) 'Code Ancien
Worksheets("Injectionblocgaine").Cells(myVar, 14) = Cell.Offset(0, 4) 'Nom d'usage
Worksheets("Injectionblocgaine").Cells(myVar, 15) = Cell.Offset(0, 5) 'Nom normalisé
Worksheets("Injectionblocgaine").Cells(myVar, 16) = Cell.Offset(0, 6) 'SECTEUR_ACTIVITE
Worksheets("Injectionblocgaine").Cells(myVar, 17) = Cell.Offset(0, 7) 'SOUS_SECTEUR_ACTIVITE
Worksheets("Injectionblocgaine").Cells(myVar, 18) = Cell.Offset(0, 15) 'Surface
Worksheets("Injectionblocgaine").Cells(myVar, 19) = Cell.Offset(0, 10) 'UG
Worksheets("Injectionblocgaine").Cells(myVar, 21) = Cell.Offset(0, 22) 'AMIANTE



ElseIf myVar = 0 Then
Cell.Offset(0, 20) = "X"
End If
End If
Next
End With
End Sub


Merci beaucoup en tout cas :)
 
Vote positif 0 Vote négatif
A

Arno94

XLDnaute Nouveau
Re : Recherche de Valeur d'un onglet sur un autre pour copie en VBA

Juste une autre question ?

Est que je peut forcer le format des cellules dans une colonne présice ?

Par exemple colonne R est la colonne code, ce code est obligatoirement sur 4 chiffres, et parfois il y a un zéro devant qui à "sauté" en court de route .... :(

J'avai trouvé ceci ici :

Code: 
Sub UG()
'
' UG Macro
' Macro enregistrée le 10/02/2011 par Administrateur
'
 Dim Plage As Range, Cellule As Range
  ' Occupant
  
  Application.ScreenUpdating = False
 
  Set Plage = Range(Cells(14, 8), Cells(Rows.Count, 8).End(xlUp)) ' évite de boucler sur toutes les lignes
  Plage.NumberFormat = "@" ' Format texte
  
  For Each Cellule In Plage
    Cellule.Value = Format(Replace(Cellule.Value, "UGC ", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UG ", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UGC", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UG", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UG", ""), "0000")
If Cellule.Column = 8 Then Cellule.Value = Replace(Cellule.Value, "ATN", "9935")
    Next Cellule
  
    ' Affectation
  
  Application.ScreenUpdating = False
 
  Set Plage = Range(Cells(14, 9), Cells(Rows.Count, 9).End(xlUp)) ' évite de boucler sur toutes les lignes
  Plage.NumberFormat = "@" ' Format texte
  
  For Each Cellule In Plage
    Cellule.Value = Format(Replace(Cellule.Value, "UGC ", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UG ", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UGC", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UG", ""), "0000")
    Cellule.Value = Format(Replace(Cellule.Value, "UG", ""), "0000")
If Cellule.Column = 8 Then Cellule.Value = Replace(Cellule.Value, "ATN", "9935")
    Next Cellule


  Application.ScreenUpdating = True
  
End Sub


Mais je n'arrive pas à l'adapter .... je ne sais pas trop quoi faire... une idée ?

Merci d'avance

Arnaud


Edit : J'ai testé ceci :
Code: 
Sub UG()
'
Dim Plage As Range, Cellule As Range
  ' Occupant
   Worksheets("Injectionbloclocal").Select
  Application.ScreenUpdating = False
 
  Set Plage = Range(Cells(5, 18), Cells(Rows.Count, 18).End(xlUp)) ' évite de boucler sur toutes les lignes
  Plage.NumberFormat = "@" ' Format texte
  
  For Each Cellule In Plage
    Cellule.Value = Format(Replace(Cellule.Value, "", ""), "0000")
    Next Cellule
  
End Sub

En faite cela ne marche pas du tout, enfin si mais pas completement, cela change bien mes cellules rempli par le format choisi (XXXX) mais cela bloque la modification ulterieure des cellules traités (L'utilisateur à restreint etc) et en pluse cela ne s'arrete pas à la derniere cellule remplie...

Suis paumé je crois ...... si quelqu'un peux me retouver cela m'arrangerais :)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

V
  • Résolu(e)
XL 2019 fonction RECHERCHEV
Réponses
6
Affichages
297
vincentast
V
V
  • Résolu(e)
XL 2019 fonction SI
Réponses
4
Affichages
146
nat54
nat54
T
  • Résolu(e)
XL 2016 Synthese - renvoi d'info sur un onglet
2
Réponses
15
Affichages
622
tuti
T
Lisette
  • Question
Microsoft 365 VBA : copier / coller d'un onglet à l'autre en fonction d'une valeur
Réponses
8
Affichages
507
Lisette
Lisette
J
  • Question
XL 2010 définir un nom de cellule en fonction de la valeur d'une autre
Réponses
10
Affichages
455
jojo4738
J
J
  • Question
XL 2013 Boucle : copie valeur d'une table dans un autre onglet jusqu'à cellule non vide
Réponses
4
Affichages
355
jerome91
J
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
435
olivieroma
O
luno123
  • Question
XL 2016 Remplir automatiquement un onglet
2
Réponses
16
Affichages
855
job75
job75
F
  • Résolu(e)
Microsoft 365 copier coller des colonnes en fonction de la valeur d'une cellule
Réponses
8
Affichages
554
loloboc
L
T
  • Question
XL 2016 Listes déroulantes dépendantes
Réponses
11
Affichages
585
Thierry310
T

Membres actuellement en ligne

24 membres et 395 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 671
Messages
2 111 775
Membres
111 296
dernier inscrit
louka29