Sub test() Dim Tableau() Dim a As Integer Sheets("donnees").Select With ActiveSheet.Range("A1").CurrentRegion ReDim Tableau(.Rows.Count, .Columns.Count) Tableau = .Value End With For a = 2 To Range("B" & Rows.Count).End(xlUp).Row If Tableau(a, 2) <> "" Then statut = Tableau(a, 2) & vbLf & Tableau(a, 1) & vbLf & Tableau(a, 3) 'ajout Tableau(a, 3) pour voir si données dans la bonne cellule idclient = Tableau(a, 3) 'Debug.Print statut End If Next a Sheets("resultat").Select ??? End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionJe vais donc me "guider" vers un autre forum avec une vraie catégorie "débutant" ou j'espère ne pas tomber ce genre de réponse.
Dim pl_sup As Range, derlig As Long, ou As Long, i As Long, dercol As Long Application.ScreenUpdating = False With Sheets("Données") derlig = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:C" & derlig).Copy Destination:=Sheets("Résultat").Range("A2") End With With Sheets("Résultat") .Range("A2:C" & derlig).Sort key1:=.Range("C2:C" & derlig) .Range("A2:B" & derlig).Copy Destination:=.Range("D2") ou = 2 For i = 3 To derlig + 1 If InStr(.Cells(ou, 4).Value, Chr(10)) 0 Then .Cells(ou, 4).Value .Cells(ou, 4).Value & Chr(10) & .Cells(ou, 5).Value dercol = .Cells(ou, Columns.Count).End(xlToLeft).Column + 1 If .Range("C" & ou).Value = .Range("C" & i).Value Then If pl_sup Is Nothing Then Set pl_sup = .Range("C" & i) Else Set pl_sup = Union(pl_sup, .Range("C" & i)) End If .Cells(ou, dercol).Value = Range("D" & i).Value & Chr(10) & .Range("E" & i).Value Else ou = i End If Next pl_sup.EntireRow.Delete Set pl_sup = Union(.Columns(1), .Columns(2), .Columns(5)) pl_sup.EntireColumn.Delete .Range("A1").Value = "CLIENT" End With Application.ScreenUpdating = True