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