texte Excel VBA à la colonne

Question

C'est ce que j'ai actuellement:

H101 John Doe Jane Doe Jack Doe  
H102 John Smith Jane Smith Katie Smith Jack Smith 

Et voici ce que je veux:

H101 John Doe 
H101 Jane Doe 
H101 Jack Doe 
H102 John Smith 
H102 Jane Smith 
H102 Katie Smith 
H102 Jack Smith 

Il est évident que je veux faire sur une plus grande échelle. Le nombre de colonnes est compris entre 1 & 6, donc je ne peux pas le limiter de cette façon. J'ai pu obtenir un script qui me permet de mettre chaque individu sur une seule ligne. Cependant, j'ai du mal à faire recopier la première colonne à chaque rangée.

Sub ToOneColumn() 
Dim i As Long, k As Long, j As Integer 
Application.ScreenUpdating = False 
Columns(2).Insert 
i = 0 
k = 1 
While Not IsEmpty(Cells(k, 3)) 
    j = 3 
    While Not IsEmpty(Cells(k, j)) 
     i = i + 1 
     Cells(i, 1) = Cells(k, 1) //CODE IN QUESTION 
     Cells(i, 2) = Cells(k, j) 
     Cells(k, j).Clear 
     j = j + 1 
    Wend 
    k = k + 1 
Wend 
Application.ScreenUpdating = True 
End Sub 

Comme je l'ai dit, il fonctionnait très bien mettre tout le monde chacun sur leur propre ligne, mais ne peut pas comprendre comment obtenir cette première colonne. Il semble que ça devrait être si simple, mais ça m'embête. Toute aide est grandement appréciée.

Answer 1

Je pense que vous écrivez vos données dans la colonne 1. Vous créez une nouvelle colonne pour les noms mais pas pour la première colonne, bien que cela dépende exactement de votre format d'origine.

Essayez ceci:

Sub ToOneColumn() 
Dim i As Long, k As Long, j As Integer 
Application.ScreenUpdating = False 
Columns(2).Insert 
Columns(2).Insert 
i = 0 
k = 1 
While Not IsEmpty(Cells(k, 3)) 
    j = 4 
    While Not IsEmpty(Cells(k, j)) 
     i = i + 1 
     Cells(i, 2) = Cells(k, 1) //CODE IN QUESTION 
     Cells(i, 3) = Cells(k, j) 
     Cells(k, j).Clear 
     j = j + 1 
    Wend 
    k = k + 1 
Wend 
Application.ScreenUpdating = True 
End Sub 

Ensuite, supprimez tous, mais les deux colonnes créées.