Re : Bonjour le forum je sollicite votre imagination
Encore moi, bonjour à tous
Voici un correctif pour éviter que les données s'écrasent.
Pour le reste je n'aurai pas le temps de le résoudre, je dois partir.
Sub selectionner(ByVal Cell As Range)
Dim StrMetier As String
Dim StrRech As String
Dim Champs As Range
Dim C As Range
'*********************************
'type de travail
'*********************************
StrRech = Cell.Offset(0, 12).Value
'*********************************
'métier
'*********************************
StrMetier = Cell.Offset(0, 5).Value
With FeuilleCible(StrMetier)
Set Champs = .Range("D😀")
Set C = Champs.Find(StrRech)
If Not C Is Nothing Then
'************************************
'détecte la ligne où copier les infos
'************************************
If C.Offset(1, 0).Value <> "" Then
l = C.End(xlDown).Row + 1
Else
l = C.Offset(1, 0).Row
End If
'************************************************************************
'assure un espace entre la dernière ligne et le type de travail suivant
'************************************************************************
If C.Offset(1, 0).Value <> "" Then .Rows(l).Insert shift:=xlDown
'
.Cells(l, 1).Value = Cell.Offset(0, 1).Value
.Cells(l, 2).Value = Cell.Offset(0, 2).Value
.Cells(l, 3).Value = Cell.Offset(0, 3).Value
.Cells(l, 4).Value = Cell.Offset(0, 4).Value
.Cells(l, 5).Value = Cell.Offset(0, 5).Value
.Cells(l, 6).Value = Cell.Offset(0, 6).Value
.Cells(l, 7).Value = Cell.Offset(0, 7).Value
.Cells(l, 8).Value = Cell.Offset(0, 8).Value
.Cells(l, 9).Value = Cell.Offset(0, 9).Value
.Cells(l, 10).Value = Cell.Offset(0, 10).Value
.Cells(l, 11).Value = Cell.Offset(0, 11).Value
.Cells(l, 12).Value = Cell.Offset(0, 12).Value
.Cells(l, 13).Value = Cell.Offset(0, 13).Value
.Cells(l, 14).Value = Cell.Offset(0, 14).Value
.Cells(l, 15).Value = Cell.Offset(0, 15).Value
.Cells(l, 16).Value = Cell.Offset(0, 16).Value
.Cells(l, 17).Value = Cell.Offset(0, 17).Value
.Cells(l, 18).Value = Cell.Offset(0, 18).Value
.Cells(l, 19).Value = Cell.Offset(0, 19).Value
.Cells(l, 20).Value = Cell.Offset(0, 20).Value
.Cells(l, 21).Value = Cell.Offset(0, 21).Value
.Cells(l, 22).Value = Cell.Offset(0, 22).Value
.Cells(l, 23).Value = Cell.Offset(0, 23).Value
.Cells(l, 24).Value = Cell.Offset(0, 24).Value
.Cells(l, 25).Value = Cell.Offset(0, 25).Value
.Cells(l, 26).Value = Cell.Offset(0, 26).Value
.Cells(l, 27).Value = Cell.Offset(0, 27).Value
.Cells(l, 28).Value = Cell.Offset(0, 28).Value
.Cells(l, 29).Value = Cell.Offset(0, 29).Value
.Cells(l, 30).Value = Cell.Offset(0, 30).Value
.Cells(l, 31).Value = Cell.Offset(0, 31).Value
.Cells(l, 32).Value = Cell.Offset(0, 32).Value
'
'etc.....
'
End If
End With
End Sub
Cordialement