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