Repartir cellule en ligne avec plusieurs colonne
Bonjour,
J ai un pb sur un fichier où il y a dans des cellules (dans différentes colonne) plusieurs ligne de texte que je voudrais repartir dans une ligne par ligne de texte. Et cela en gardant les lien entre les différentes colonnes.
J ai trouvé une macro pour agir sur une colonne mais je ne sais pas comment faire pour faire tout le tableau en gardant les liens.
Je joints un fichier avec deux onglet "donnée de départ" et un onglet du résultat que je veux obtenir (la macro est dedans)
Merci d avance à ts
Bonjour,
Sub Macro()
Dim aa, CC, i%, n%, x%, j%
aa = ActiveSheet.Range("A1").CurrentRegion.Resize(, 5).Value
Application.ScreenUpdating = False
With Worksheets.Add(after:=ActiveSheet)
For i = 2 To UBound(aa)
CC = Split(aa(i, 1), Chr(10))
n = n + 2: x = UBound(CC)
.Cells(n, 1).Resize(x + 1).Value = WorksheetFunction.Transpose(CC)
For j = 2 To 4
.Cells(n + 1, j) = aa(i, j)
Next j
CC = Split(aa(i, 5), Chr(10))
If UBound(CC) > x Then x = UBound(CC)
.Cells(n, 5).Resize(UBound(CC) + 1).Value = WorksheetFunction.Transpose(CC)
n = n + x
Next i
.Range("A2:E" & n).Borders.Weight = xlThin
End With
End SubCordialement.
edit : Salut Paritec !
Bonjour MFerrand
bonjour bonjour
a+
papou
Merci pour votre aide.
Je vais l adapter a mon fichier
Bonjour MFerrand
RemyPaul le forum bonjour bonjour
a+
papou
Bonjour,
J ai adapter ta macro a mon fichier mais j ai une erreur
Ci dessous la macro adaptée, en gras la ligne en erreur (Erreur 1004 : erreur définit par l application ou l'objet)
Si tu as une idée
Merci d'avance
Option Explicit
Sub test()
Dim aa, i&, a&, bb, x, n&, y&, col&, fin&, cc
With Feuil2
aa = .Range("A1:T3350")
End With
Feuil3.Cells.Clear
y = 1
For i = 1 To UBound(aa)
For a = 1 To UBound(aa, 2)
x = Split(aa(i, a), Chr(10))
If col < UBound(x) Then col = UBound(x)
Next a
col = col + 1
ReDim bb(1 To col, 1 To UBound(aa, 2))
For a = 1 To UBound(aa, 2)
x = Split(aa(i, a), Chr(10))
For n = 0 To UBound(x)
bb(n + 1, a) = x(n)
Next n
Next a
fin = Feuil3.Range("A" & Rows.Count).End(xlUp).Row + 1
Feuil3.Range("A" & fin).Resize(UBound(bb), UBound(bb, 2)) = bb
Feuil3.Range(Feuil3.Cells(fin, 1), Feuil3.Cells(fin + UBound(bb) - 1, 20)).Borders.LineStyle = 1
col = 0
Next i
End Sub
Bonjour Remypaul le forum
sans avoir le fichier c'est pas simple
pour moi une possibilité est que tu as des lignes vides, ce qui provoque le défaut
a+
papou
Bonjour remypaul le forum
bah oui je sais, heureusement pour moi!!!
a+
papou
Re remyPaul le forum
une fois de plus une demande avec un fichier fourni qui ne correspond en rien à la demande finale!!!
on passe de 5 colonnes à 20 colonnes et de 2 lignes à 3350 !!!!!!!
bref , par chance j'avais prévu le coup!!!!
a+
papou