Discussion :

[initial32]

Bonjour,

Je cherche un petit script VBA pour effectuer la tâche suivante :

J'ai une longue liste de données Excel qui se présente sur cette forme :
Nom, Prénom
Institution
Ville
Adresse email
Nom, Prénom
Institution
Ville
Adresse email
Nom, Prénom
Institution
Ville
Adresse email
...etc.
Une fois de temps en temps, il y a un nom de pays.

Je cherche un script qui mettrait sur la même ligne (avec une virgule en séparateur) tous les éléments jusqu'à "Adresse email". ça ferait donc
Nom, Prénom, Institution, Ville, Adresse email
Nom, Prénom, Institution, Ville, Adresse email
Nom, Prénom, Institution, Ville, Adresse email
Nom, Prénom, Institution, Ville, Adresse email

Et une fois de temps en temps, on aurait "Pays, Nom, Prénom, Institution, Ville, Adresse email" mais c'est pas grave.

Sauriez-vous comment faire ?

Merci pour votre aide !

[Invité]

Bonjour,
test ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Test()
Dim R As Range
Set R = Sheets("Data").UsedRange
Dim DerL As Long
For l = 1 To R.Rows.Count Step 4
    DerL = Sheets("Resultat").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
    If R(l, 1) = "Pays" Then
         Sheets("Resultat").Range(Sheets("Resultat").Cells(DerL, 1), Sheets("Resultat").Cells(DerL, 1).Offset(0, 4)) = Application.Transpose(R.Range(R.Cells(l, 1), R(l, 1).Offset(4)))
         l = l + 1
    Else
       Sheets("Resultat").Range(Sheets("Resultat").Cells(DerL, 1), Sheets("Resultat").Cells(DerL, 1).Offset(0, 3)) = Application.Transpose(R.Range(R.Cells(l, 1), R(l, 1).Offset(3)))
    End If
Next
End Sub

[initial32]

Merci rdurupt ! J'ai testé le code mais j'obtiens une erreur d'exécution '9' : "L'indice n'appartient pas à la sélection".

Je joins un extrait de mon fichier pour que vous puissiez voir comment se présentent les données.

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Test()
Dim R As Range
Set R = Sheets("Data").UsedRange
Dim DerL As Long
For l = 1 To R.Rows.Count Step 4
    DerL = Sheets("Resultats").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
        If InStr(Trim("" & R(l, 1).Offset(4)), ",") = 0 And Trim("" & R(l, 1).Offset(4)) <> "" Then
         Sheets("Resultats").Range(Sheets("Resultats").Cells(DerL, 1), Sheets("Resultats").Cells(DerL, 1).Offset(0, 4)) = Application.Transpose(R.Range(R.Cells(l, 1), R(l, 1).Offset(4)))
         l = l + 1
    Else
       Sheets("Resultats").Range(Sheets("Resultats").Cells(DerL, 1), Sheets("Resultats").Cells(DerL, 1).Offset(0, 3)) = Application.Transpose(R.Range(R.Cells(l, 1), R(l, 1).Offset(3)))
    End If
Next
End Sub

[initial32]

Ahahah, trop balèze !
Un grand MERCI ! ça marche parfaitement !

[initial32]

En utilisant ce script, je me suis aperçu qu'il mettait sur la même ligne le contenu de 4 lignes, puis il recommence.
Idéalement, je préférerais que le script mette sur la même ligne le contenu de toutes les lignes jusqu'à ce qu'il trouve une ligne avec une adresse email (ou le symbole @, ce qui revient au même). Dans ce cas, il faut commencer à écrire une nouvelle ligne dans la feuille "Resultats".
Sauriez-vous faire ça ?