Rangement par ligne

Bonjour,

J'ai un fichier de données avec plusieurs lignes pour la même entreprise : la différence est dans le nom des contacts.

Mon besoin : Avoir toutes mes informations sur une seule ligne : ce qui revient à monter et concatener plusieurs lignes sur une seule.

Merci pour votre aide,

J'ai essayé ceci mais ça ne fonctionne pas !

Sub trier_horizontal()

Dim DerCol As Integer, Derlig As Integer, i As Integer, j As Integer

Application.ScreenUpdating = False

Derlig = Range("A65536").End(xlUp).Row

For i = Derlig To 3 Step -1

If Cells(1, i) = Cells(1, i - 1) Then

For j = 7 To DerCol

If Cells(j, i) > 0 Then

Cells(j, i - 1) = Cells(j, i)

End If

Next j

Rows Line(i).Delete

End If

Next

End Sub

Merci à vous.

Bonsoir

Je me suis inspiré de la macro de Nad ici

On concatène de G à P

Sub Trier()
Dim Derlig As Long, I As Integer, J As Integer
Application.ScreenUpdating = False

  Derlig = Range("A65536").End(xlUp).Row

  For J = Derlig To 3 Step -1
    If Cells(J, 1) = Cells(J - 1, 1) Then
      For I = 7 To 16
        If Cells(J, I) <> "" Then
          If Cells(J - 1, I) <> "" Then
            Cells(J - 1, I) = Cells(J - 1, I) & Chr(10)
          End If
          Cells(J - 1, I) = Cells(J - 1, I) & Cells(J, I)
        End If
      Next I
      Rows(J).Delete
    End If
  Next J
End Sub

Vous êtes des magiciens pour moi !!!

J'avais essayé aussi de m'inspirer de la macro précédente mais j'ai pas cette compétence.

Merci à vous !!

Il y a malheureusement un souci :

Lorsque la colonne "entreprise" a le même nom avec plusieurs adresses (donc sur plusieurs lignes), la concatenation prends par défaut la 1ére ligne et supprime les autres !

Je perds donc des données.

La différence est dans l'adresse à chaque fois ou le département (colonne D)

Pouvez-vous modifier la macro édité par Banzai64 (ou vous ) ?

J'ai essayé mais pas assez calé pour ça

Merci

Bonjour

Un peu plus complexe

A vérifier soigneusement

Sub Trier()
Dim Derlig As Long, I As Integer, J As Integer
Application.ScreenUpdating = False

  Derlig = Range("A65536").End(xlUp).Row

  For J = Derlig To 3 Step -1
    If Cells(J, 1) = Cells(J - 1, 1) Then
      For I = 2 To 16
        If Cells(J, I) <> "" Then                         ' Quelque chose à recopier
          If Cells(J - 1, I) <> "" Then                   ' Cellule de destination n'est pas vide
            If InStr(1, Cells(J, I), Cells(J - 1, I), vbTextCompare) = 0 Then
              ' Le contenu de la cellule de destination n'est pas présent dans la cellule à recopier
              Cells(J - 1, I) = Cells(J - 1, I) & Chr(10) & Cells(J, I)
            Else
              ' Le contenu de la cellule de destination est présent dans la cellule à recopier
              Cells(J - 1, I) = Cells(J, I)
            End If
          Else                                            ' Cellule de destination est vide
            Cells(J - 1, I) = Cells(J, I)
          End If
        End If
      Next I
      Rows(J).Delete
    End If
  Next J
End Sub

Je me doute que c'est plus complexe !

Cela fonctionne pour les entreprises et les plusieurs adresses possibles... En revanche, la macro regroupe toutes les adresses sur une seule case et par conséquent, les noms des contacts aussi.

De ce fait, je perds le lien entre les adresses et les noms.

Merci pour ce travail

J'ai utilisé cette macro et travailler sur le fichier en renommant les entreprises avec plusieurs adresses et ainsi obtenir tous mes contacts.

Merci