bonsoir,
j’ai un grand tableau et je voudrait réaranger les données d’une autre manière.
comme dans le fichier joint
tableau.xlsx (9,8 Ko)
je suis novice et un peu paumé
si quelqu’un peut m’aider à le faire en automatique…
merci à tous
bonsoir,
j’ai un grand tableau et je voudrait réaranger les données d’une autre manière.
comme dans le fichier joint
tableau.xlsx (9,8 Ko)
je suis novice et un peu paumé
si quelqu’un peut m’aider à le faire en automatique…
merci à tous
Bonjour,
Un petit peu Ardu avec les cellules fusionnées, surtout que les blocs ne sont pas identiques
La Procédure:
Option Explicit
Dim NbLig%, l%, c%, i%, j%, Nbcol%, Dl%, art% 'Déclaration des variables
Sub Transposer()
Range("H6").CurrentRegion.Clear 'Efface l'ancien tableau transposé
'ARTICLE
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Copy 'Sélection de la colonne B
Range("D1").Select 'copie sur colonne D
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
Range("D1").Select 'Supprime les doublons
NbLig = Range(Selection, Selection.End(xlDown)).Count 'Mémorise le Nb de ligne dans variable
Range(Selection, Selection.End(xlDown)).Copy 'Sélectionne les valeurs colonne D
Range("I6").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Columns("D:D").Clear 'Colle les données en I6 en les tranposant en horizontal et efface colonne D
Nbcol = NbLig 'Attribue le Nb ligne à la variable Nbcol (Nb colonne)
l = 7: c = 8
'BOITE
Range("A2").Select
NbLig = Range("A2").MergeArea.Cells.Count 'Récupère le Nb ligne pour le 1er bloc fusionné
Cells(l, c) = ActiveCell.Value 'colle les données dans le nouveau tableau
l = l + 1
While Selection.Offset(1, 0) <> "" 'Effectue une boucle sur tous les blocs fusionnés pour les coller à la suite
Selection.Offset(1, 0).Select
Cells(l, c) = ActiveCell.Value
l = l + 1
Wend
Dl = Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne colonne B
Columns("A:A").Select 'Sélectionne la colonne A et défusionne les blocs
Selection.UnMerge
Range("A2").Select
For i = 2 To Dl
If Cells(i, 1).Value = "" Then
Cells(i, 1) = Cells(i - 1, 1)
End If
Next i
'QUANTITE
Range("I7").Select 'Effectue une triple boucle pour remettre les données dans le nouveau tableau
For art = 9 To Nbcol + 8
For j = 7 To NbLig + 6
For i = 2 To Dl
If Cells(i, 1).Value = Cells(j, 8).Value And _
Cells(i, 2).Value = Cells(6, art).Value Then
Cells(j, art).Value = Cells(i, 3).Value
End If
Next i
Next j
Next art
MiseEnForme 'Exécute la macro MiseEnForme pour le centrage et le quadrillage
End Sub
Sub MiseEnForme()
Range(Cells(6, 8), Cells(6, 8).Offset(NbLig, Nbcol)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
End With
Range("H6").Select
End Sub
Le Classeur
tableau.xlsm (20,8 Ko)
merci pour la réponse, mais franchement j’ai rien compris.
comment faire pour transposer cette macro sur mon tableau qui doit faire un bon millier de ligne.
Re,
D’où le principe de mettre en PJ un exemple concret et qui soit au même endroit
La solution, soit mettre ton tABLEAU en PJ, si trop confidentielle me le passer en Message privé
ok, je vois ça lundi et te tiens au courant
merci beaucoup:grinning:
Avoir une assistance c’est mieux je crois