Sub Ajout_equipement()
Dim Dest As Range
Dim lo As ListObject
Dim i As Integer, nbLignes As Integer
'
' Tableau (listobject) destination des données
Set lo = ThisWorkbook.Sheets("Projet en cours").ListObjects(1)
'
' Travail à partir de la feuille Import
With Sheets("Import")
'
nbLignes = .Range("B58").CurrentRegion.Rows.Count
'
For i = 1 To nbLignes
' si l'équipement est non vide (colonne b de la ligne en cours)
' alors créer une nouvelle ligne dans le tableau destination
If Not IsEmpty(.Cells(57 + i, 2)) Then
' Si la ligne d'insertion du tableau est affichée
If Not lo.InsertRowRange Is Nothing Then
' alors la prendre comme destination
Set Dest = lo.InsertRowRange()
Else
' sinon ajouter une ligne en bas du tableau
' et la prendre pour destination
Set Dest = lo.ListRows.Add(AlwaysInsert:=True).Range
End If
'Projet (cellules fixes)
Dest(1, 1) = .Range("F9")
Dest(1, 2) = .Range("B4")
Dest(1, 3) = .Range("B7")
Dest(1, 4) = .Range("B8")
Dest(1, 5) = .Range("B10")
Dest(1, 6) = .Range("B11")
'Client (cellules fixes)
Dest(1, 18) = .Range("B17")
Dest(1, 19) = .Range("B83")
Dest(1, 20) = .Range("B84")
Dest(1, 21) = .Range("B85")
Dest(1, 22) = .Range("B86")
'Conducteur Travaux (cellule fixe)
Dest(1, 11) = .Range("B56")
'Equipements & localisation (cellules relative à la ligne)
Dest(1, 7) = .Cells(57 + i, 2)
Dest(1, 8) = .Cells(57 + i, 5)
End If
Next
End With
End Sub