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
| Option Explicit
Public Sub Traitement()
Dim lngLigne As Long
Dim rngIndividu As Range, rngObject As Range
Worksheets("resultat").Cells.ClearContents
lngLigne = 1
For Each rngIndividu In Range("individu").Rows
If rngIndividu.Resize(1, 1).Value <> "" Then
With Worksheets("resultat")
.Cells(lngLigne, 1).Value = rngIndividu.Resize(1, 1).Value
.Cells(lngLigne, 2).Value = rngIndividu.Offset(0, 1).Resize(1, 1).Value
lngLigne = lngLigne + 2
For Each rngObject In Range("object").Rows
If rngObject.Resize(1, 1).Value = rngIndividu.Resize(1, 1).Value Then
.Cells(lngLigne, 2).Value = rngObject.Resize(1, 1).Value
.Cells(lngLigne, 3).Value = rngObject.Offset(0, 1).Resize(1, 1).Value
lngLigne = lngLigne + 1
End If
Next rngObject
lngLigne = lngLigne + 1
End With
End If
Next rngIndividu
End Sub |
Partager