Discussion :

[kaynan]

Bonjour à tous.

j'ai une feuille excel avec plusieurs colonnes et lignes,pour chaque colonne une série de lettres et chiffres.

j'aimerais bien avoir un rangement ou un tri de gauche a droite a l'aide d'un macro vba,avec ranger les colonnes qui ont les mêmes chiffres.

ci joint un ficher excel qui explore mieux ma problématique avec une sheet 'initiale" fichier source et ""chercher"" le résultat souhaité.


je compte toujours sur l'aide des génies sur ce forum.

merci bcp

[Dormeur74]

Il faut que ton fichier ne contienne que la feuille "INITIALE".
Essaye cette macro pour voir :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub Macro1()
    Dim tableau(13) As String
    Dim ordre(13) As Integer
    Dim x As Integer, y As Integer
    Dim chaine As String
    Dim pointeur As Integer
    Dim numCol As Integer
 
    Sheets("INITIALE").Select
    Sheets.Add
    Sheets("Feuil1").Select
    Sheets("Feuil1").Move After:=Sheets(2)
    Sheets("Feuil1").Select
    Sheets("Feuil1").Name = "RECHERCHER"
    Sheets("INITIALE").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("RECHERCHER").Select
    Columns("A:A").Select
    ActiveSheet.Paste
 
    Sheets("INITIALE").Select
    For x = 1 To 13
        tableau(x) = Right(Cells(1, x + 1), 3)
    Next x
 
    ' On trie dans l'ordre alphabétique des numéros
    For x = 1 To 13
        chaine = "998"
        For y = 13 To 1 Step -1
            If tableau(y) < chaine Then
                chaine = tableau(y)
                pointeur = y
            End If
        Next y
        tableau(pointeur) = "999"
        ordre(x) = pointeur
    Next x
    For x = 1 To 13
        numCol = ordre(x) + 1
        Sheets("INITIALE").Select
        Columns(Chr(64 + numCol) & ":" & Chr(64 + numCol)).Select
        Selection.Copy
        Sheets("RECHERCHER").Select
        Columns(Chr(65 + x) & ":" & Chr(65 + x)).Select
        ActiveSheet.Paste
    Next x
End Sub

[kaynan]

BJR,

c'est parfait c'est plus que parfait ....................

Un grand merci.

je vous remercie Dormeur74 ............................................