Je cherche =E0 transformer un tableau Excel "T1" en un autre=20
tableau Excel "T2"
Mon premier tableau "T1" a 2 colonnes et 7 lignes
oise picardie
finist=E8re bretagne
somme picardie
aisne picardie
c=F4tes du nord bretagne
calvados normandie
morbihan bretagne
Mon 2=E8me tableau "T2" a 4 colonnes et 3 lignes
(les colonnes sont indiqu=E9es ici par le s=E9parateur ";")
bretagne;finist=E8re;morbihan;c=F4tes du nord
normandie;calvados
picardie;oise;somme;aisne
Quelle fonctionnalit=E9 puis-je actionner dans Excel pour=20
transformer un tableau de type "T1" en un tableau de=20
type "T2"?
Naturellement, le nombre de lignes et de colonnes de "T2"=20
doit pouvoir varier en fonction des =E9l=E9ments qu'il contient
Merci par avance =E0 tous ceux qui pourront m'apporter leur=20
aide sur le sujet
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
AV
Une bidouille : Principe : - Ajouter une feuille - extraire par filtre élab. les régions sans doublon et récupérer, (par filtre) pour chacune d'elles, les départements correspondants
** Contraintes (à adapter) : Les données sont en Feuil1 Les départements sont en A2:Ax Les régions sont en B2:Bx Etiquettes de colonnes en A1:B1
Sub zz_Extract() Dim c As Range Application.ScreenUpdating = False On Error Resume Next Application.DisplayAlerts = False Sheets("Extract").Delete Sheets.Add.Name = "Extract" Application.DisplayAlerts = True Sheets("Feuil1").Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=[A1], Unique:=True: [A1] = "" [A:A].Sort Key1:=[A1], Order1:=xlAscending For Each c In Range("A1", [A65536].End(3)) With Sheets("Feuil1") .Range("B1", .[B65536].End(3)).AutoFilter Field:=1, Criteria1:=c .Range("A2", .[A65536].End(3)).SpecialCells(xlCellTypeVisible).Copy c(, 2).PasteSpecial Paste:=xlAll, Transpose:=True End With Next Sheets("Feuil1").[A1].AutoFilter Cells.EntireColumn.AutoFit: [A1].Select End Sub
AV
Une bidouille :
Principe :
- Ajouter une feuille
- extraire par filtre élab. les régions sans doublon et récupérer, (par filtre)
pour chacune d'elles, les départements correspondants
** Contraintes (à adapter) :
Les données sont en Feuil1
Les départements sont en A2:Ax
Les régions sont en B2:Bx
Etiquettes de colonnes en A1:B1
Sub zz_Extract()
Dim c As Range
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Extract").Delete
Sheets.Add.Name = "Extract"
Application.DisplayAlerts = True
Sheets("Feuil1").Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=[A1], Unique:=True: [A1] = ""
[A:A].Sort Key1:=[A1], Order1:=xlAscending
For Each c In Range("A1", [A65536].End(3))
With Sheets("Feuil1")
.Range("B1", .[B65536].End(3)).AutoFilter Field:=1, Criteria1:=c
.Range("A2", .[A65536].End(3)).SpecialCells(xlCellTypeVisible).Copy
c(, 2).PasteSpecial Paste:=xlAll, Transpose:=True
End With
Next
Sheets("Feuil1").[A1].AutoFilter
Cells.EntireColumn.AutoFit: [A1].Select
End Sub
Une bidouille : Principe : - Ajouter une feuille - extraire par filtre élab. les régions sans doublon et récupérer, (par filtre) pour chacune d'elles, les départements correspondants
** Contraintes (à adapter) : Les données sont en Feuil1 Les départements sont en A2:Ax Les régions sont en B2:Bx Etiquettes de colonnes en A1:B1
Sub zz_Extract() Dim c As Range Application.ScreenUpdating = False On Error Resume Next Application.DisplayAlerts = False Sheets("Extract").Delete Sheets.Add.Name = "Extract" Application.DisplayAlerts = True Sheets("Feuil1").Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=[A1], Unique:=True: [A1] = "" [A:A].Sort Key1:=[A1], Order1:=xlAscending For Each c In Range("A1", [A65536].End(3)) With Sheets("Feuil1") .Range("B1", .[B65536].End(3)).AutoFilter Field:=1, Criteria1:=c .Range("A2", .[A65536].End(3)).SpecialCells(xlCellTypeVisible).Copy c(, 2).PasteSpecial Paste:=xlAll, Transpose:=True End With Next Sheets("Feuil1").[A1].AutoFilter Cells.EntireColumn.AutoFit: [A1].Select End Sub
