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

J
  • Question
XL 2013 Boucle : copie valeur d'une table dans un autre onglet jusqu'à cellule non vide
Réponses
4
Affichages
160
jerome91
J
luno123
  • Question
XL 2016 Remplir automatiquement un onglet
2
Réponses
16
Affichages
538
job75
job75
T
  • Question
XL 2016 Listes déroulantes dépendantes
Réponses
11
Affichages
315
Thierry310
T
K
  • Question
Microsoft 365 VBA - Confusion dans la macro
Réponses
1
Affichages
304
karexcel
K
W
  • Question
XL 2021 Boucle copier-coller par nom d'en-tête de colonnes
Réponses
10
Affichages
313
whiteshark
W
V
  • Question
Microsoft 365 besoin d'aide sur une formule comptage le nombre de jour dans un calendrier
Réponses
7
Affichages
417
vincentast
V
B
  • Question
XL 2016 recherche dans une colonne depuis un autre onglet
Réponses
5
Affichages
136
boguinette
B
JoBar57
  • Question
XL 2021 Collecter des données et les restituer après mise en forme dans un autre onglet
Réponses
8
Affichages
392
JoBar57
JoBar57
K
  • Question
Autres 'Résolu'Effectuer en VBA une recherche dans une colonne
Réponses
3
Affichages
223
klorane
K
P
  • Résolu(e)
concaténation de cellules dans un autre onglet
Réponses
9
Affichages
381
PR.
P

Membres actuellement en ligne

10 membres et 172 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
312 159
Messages
2 085 836
Membres
102 998
dernier inscrit
billABDELL