je voudrais trier ma colonne du plus petit au plus grand

Le
joseph84
Bonjour tout le monde

voila mon code l explication viendra apres :

Sub test()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDest As Integer, ColSource As Integer
With Workbooks("Données").Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Workbooks("Suivi").Worksheets("Feuil1")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour d terminer la colonne source o sont les donn es
ColSource = Columns("G").Column - 1

'Pour d terminer la colonne o seront copi es les donn es
ColDest = Columns("CZ").Column - 1

For Each C In Plg
x = Application.Match(C, Rg, 0)
If Not IsError(x) Then
C.Offset(, ColDest).Value = Rg(x).Offset(, ColSource).Value
End If
Next
End Sub



Master plan.xls

A B C D E F G
00001 2

00234 5

11002 3

13424 6


je veux copier ma colonne G et la coller dans un autre autre classeur
dans la colonne CZ par rapport a la colonne A en plus en triant la G
du plus grand au plus petit le résultat est en forme de:


Suivi.xlsm


A B C D . CZ
00001 2

11002 3

00234 5

13424 6


Merci d avance.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #23273811
Bonjour,

Copie ceci dans un module standard de ton projet.

Assure-toi que les noms des Workbook et Worksheet sont
bien identifiés aux objets de ton projet.

'------------------------------------
Sub test()

Dim Tblo As Variant

With Workbooks("Master plan.xls").Worksheets("Feuil1")
Tblo = Application.Transpose(.Range("A1:A" & _
.Range("A65536").End(xlUp).Row))
End With

Quick_Sort Tblo, LBound(Tblo), UBound(Tblo)
Application.EnableEvents = False
Workbooks("Classeur_Destination.xls").Worksheets("Feuil2"). _
Range("CZ1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Application.EnableEvents = True

End Sub
'------------------------------------

Sub Quick_Sort(ByRef SortArray As Variant, _
ByVal First As Long, ByVal Last As Long)

Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
'------------------------------------



MichD
--------------------------------------------
"joseph84" a écrit dans le message de groupe de discussion :


Bonjour tout le monde

voila mon code l explication viendra apres :

Sub test()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDest As Integer, ColSource As Integer
With Workbooks("Données").Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Workbooks("Suivi").Worksheets("Feuil1")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour d terminer la colonne source o sont les donn es
ColSource = Columns("G").Column - 1

'Pour d terminer la colonne o seront copi es les donn es
ColDest = Columns("CZ").Column - 1

For Each C In Plg
x = Application.Match(C, Rg, 0)
If Not IsError(x) Then
C.Offset(, ColDest).Value = Rg(x).Offset(, ColSource).Value
End If
Next
End Sub



Master plan.xls

A B C D E F G
00001 2

00234 5

11002 3

13424 6


je veux copier ma colonne G et la coller dans un autre autre classeur
dans la colonne CZ par rapport a la colonne A en plus en triant la G
du plus grand au plus petit le résultat est en forme de:


Suivi.xlsm


A B C D ....... CZ
00001 2

11002 3

00234 5

13424 6


Merci d avance.
MichD
Le #23273871
Tu préfères peut-être ceci :

Tu colles cette macro dans le module standard du
classeur Source.

Assure-toi que les noms des classeurs et feuilles sont
ceux de ton application

'------------------------------------------
Sub test()

Dim Rg As Range

'Classeur et feuille source où sont tes données
With ThisWorkbook.Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Classeur et feuille de destination
With Workbooks("classeur2").Worksheets("Feuil1")
.Range("CZ1").Resize(Rg.Rows.Count) = Rg.Value
End With

'Tri sur la colonne CZ de la feuille de destination
With Workbooks("Master plan.xls").Worksheets("Feuil1")
With .Range("CZ1").Resize(Rg.Rows.Count)
.Sort Key1:=.Item(2, 1), order1:=xlAscending, Header:=xlNo
End With
End With

End Sub
'------------------------------------------


MichD
--------------------------------------------
"MichD" a écrit dans le message de groupe de discussion : insnuv$vs9$

Bonjour,

Copie ceci dans un module standard de ton projet.

Assure-toi que les noms des Workbook et Worksheet sont
bien identifiés aux objets de ton projet.

'------------------------------------
Sub test()

Dim Tblo As Variant

With Workbooks("Master plan.xls").Worksheets("Feuil1")
Tblo = Application.Transpose(.Range("A1:A" & _
.Range("A65536").End(xlUp).Row))
End With

Quick_Sort Tblo, LBound(Tblo), UBound(Tblo)
Application.EnableEvents = False
Workbooks("Classeur_Destination.xls").Worksheets("Feuil2"). _
Range("CZ1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Application.EnableEvents = True

End Sub
'------------------------------------

Sub Quick_Sort(ByRef SortArray As Variant, _
ByVal First As Long, ByVal Last As Long)

Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
'------------------------------------



MichD
--------------------------------------------
"joseph84" a écrit dans le message de groupe de discussion :


Bonjour tout le monde

voila mon code l explication viendra apres :

Sub test()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDest As Integer, ColSource As Integer
With Workbooks("Données").Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Workbooks("Suivi").Worksheets("Feuil1")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour d terminer la colonne source o sont les donn es
ColSource = Columns("G").Column - 1

'Pour d terminer la colonne o seront copi es les donn es
ColDest = Columns("CZ").Column - 1

For Each C In Plg
x = Application.Match(C, Rg, 0)
If Not IsError(x) Then
C.Offset(, ColDest).Value = Rg(x).Offset(, ColSource).Value
End If
Next
End Sub



Master plan.xls

A B C D E F G
00001 2

00234 5

11002 3

13424 6


je veux copier ma colonne G et la coller dans un autre autre classeur
dans la colonne CZ par rapport a la colonne A en plus en triant la G
du plus grand au plus petit le résultat est en forme de:


Suivi.xlsm


A B C D ....... CZ
00001 2

11002 3

00234 5

13424 6


Merci d avance.
joseph84
Le #23273891
On 10 avr, 13:04, "MichD"
Bonjour,

Copie ceci dans un module standard de ton projet.

Assure-toi que les noms des Workbook et Worksheet sont
bien identifiés aux objets de ton projet.

'------------------------------------
Sub test()

Dim Tblo As Variant

With Workbooks("Master plan.xls").Worksheets("Feuil1")
    Tblo = Application.Transpose(.Range("A1:A" & _
                    .Range("A65536").End(xlUp).Row))
End With

Quick_Sort Tblo, LBound(Tblo), UBound(Tblo)
Application.EnableEvents = False
Workbooks("Classeur_Destination.xls").Worksheets("Feuil2"). _
    Range("CZ1").Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Application.EnableEvents = True

End Sub
'------------------------------------

Sub Quick_Sort(ByRef SortArray As Variant, _
    ByVal First As Long, ByVal Last As Long)

Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
    Do While (SortArray(Low) < List_Separator)
        Low = Low + 1
    Loop
    Do While (SortArray(High) > List_Separator)
        High = High - 1
    Loop
    If (Low <= High) Then
        Temp = SortArray(Low)
        SortArray(Low) = SortArray(High)
        SortArray(High) = Temp
        Low = Low + 1
        High = High - 1
    End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
'------------------------------------

MichD
--------------------------------------------
"joseph84"  a écrit dans le message de groupe de discussion :


Bonjour tout le monde

voila mon code l explication viendra apres :

Sub test()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDest As Integer, ColSource As Integer
With Workbooks("Données").Worksheets("Feuil1")
    Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Workbooks("Suivi").Worksheets("Feuil1")
    Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour d terminer la colonne source o sont les donn es
ColSource = Columns("G").Column - 1

'Pour d terminer la colonne o seront copi es les donn es
ColDest = Columns("CZ").Column - 1

For Each C In Plg
    x = Application.Match(C, Rg, 0)
    If Not IsError(x) Then
        C.Offset(, ColDest).Value = Rg(x).Offset(, ColSource).V alue
    End If
Next
End Sub

Master plan.xls

A           B         C       D       E       F      G
00001                                                    2

00234                                                    5

11002                                                    3

13424                                                    6

je veux copier ma colonne G et la coller dans un autre autre classeur
dans la colonne CZ par rapport a la colonne A en plus en triant la G
du plus grand au plus petit le résultat est en forme de:

Suivi.xlsm

A           B       C    D  ....... CZ


ID Tri

00001                                   2

11002                                   3

00234                                 5

13424                                   6

Merci d avance.



Merci Mchid

j aimerais quand il copie la colonne dans le classeur de destination
qu'il le trie du plus petit au plus grand mais en respectant la
colonne ID

l exemple montre bien ce que je veux faire

A B C D E F G
ID Tri
00001 2

00234 5

11002 3

13424 6


A B C D ....... CZ
ID Tri

00001 2

11002 3

00234 5

13424 6

Merci
joseph84
Le #23273951
On 10 avr, 13:38, joseph84
On 10 avr, 13:04, "MichD"
> Bonjour,

> Copie ceci dans un module standard de ton projet.

> Assure-toi que les noms des Workbook et Worksheet sont
> bien identifiés aux objets de ton projet.

> '------------------------------------
> Sub test()

> Dim Tblo As Variant

> With Workbooks("Master plan.xls").Worksheets("Feuil1")
>     Tblo = Application.Transpose(.Range("A1:A" & _
>                     .Range("A65536").End(xlUp).Row) )
> End With

> Quick_Sort Tblo, LBound(Tblo), UBound(Tblo)
> Application.EnableEvents = False
> Workbooks("Classeur_Destination.xls").Worksheets("Feuil2"). _
>     Range("CZ1").Resize(UBound(Tblo)) = Application.Transpose(Tbl o)
> Application.EnableEvents = True

> End Sub
> '------------------------------------

> Sub Quick_Sort(ByRef SortArray As Variant, _
>     ByVal First As Long, ByVal Last As Long)

> Dim Low As Long, High As Long
> Dim Temp As Variant, List_Separator As Variant
> Low = First
> High = Last
> List_Separator = SortArray((First + Last) / 2)
> Do
>     Do While (SortArray(Low) < List_Separator)
>         Low = Low + 1
>     Loop
>     Do While (SortArray(High) > List_Separator)
>         High = High - 1
>     Loop
>     If (Low <= High) Then
>         Temp = SortArray(Low)
>         SortArray(Low) = SortArray(High)
>         SortArray(High) = Temp
>         Low = Low + 1
>         High = High - 1
>     End If
> Loop While (Low <= High)
> If (First < High) Then Quick_Sort SortArray, First, High
> If (Low < Last) Then Quick_Sort SortArray, Low, Last
> End Sub
> '------------------------------------

> MichD
> --------------------------------------------
> "joseph84"  a écrit dans le message de groupe de discussion :
>

> Bonjour tout le monde

> voila mon code l explication viendra apres :

> Sub test()

> Dim Rg As Range, Plg As Range, C As Range
> Dim ColDest As Integer, ColSource As Integer
> With Workbooks("Données").Worksheets("Feuil1")
>     Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
> End With

> With Workbooks("Suivi").Worksheets("Feuil1")
>     Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
> End With

> 'Pour d terminer la colonne source o sont les donn es
> ColSource = Columns("G").Column - 1

> 'Pour d terminer la colonne o seront copi es les donn es
> ColDest = Columns("CZ").Column - 1

> For Each C In Plg
>     x = Application.Match(C, Rg, 0)
>     If Not IsError(x) Then
>         C.Offset(, ColDest).Value = Rg(x).Offset(, ColSource) .Value
>     End If
> Next
> End Sub

> Master plan.xls

> A           B         C       D       E       F      G
> 00001                                                    2

> 00234                                                    5

> 11002                                                    3

> 13424                                                    6

> je veux copier ma colonne G et la coller dans un autre autre classeur
> dans la colonne CZ par rapport a la colonne A en plus en triant la G
> du plus grand au plus petit le résultat est en forme de:

> Suivi.xlsm

> A           B       C    D  ....... CZ

  ID                                        Tri

> 00001                                  2

> 11002                                  3

> 00234                                 5

> 13424                                  6

> Merci d avance.

Merci Mchid

j aimerais quand il copie la colonne dans le classeur de destination
qu'il le trie du plus petit au plus grand mais en respectant la
colonne ID

l exemple montre bien ce que je veux faire

A           B         C       D       E       F      G
ID                                                         Tri
00001                                                    2

00234                                                    5

11002                                                    3

13424                                                    6

 A           B       C    D  ....... CZ
 ID                                       Tri

00001                                   2

11002                                   3

00234                                   5
J
13424                                   6

Merci



JE vois que je m exprime mal je vais l etre un peux plus

j aimerais quand je copie la colonne Tri qu il me la colle dans le
classeur destination et en matchant avec la colonne ID qui se trouve
dans les deux classeur

Merci
MichD
Le #23274021
Bonjour,

Le principe : On insère dans la dernière colonne le numéro des lignes
de 1 à x dans la feuille source.
On trie la colonne A:A la feuille source en incluant tout le tableau

On copie dans la feuille de destination, seulement la colonne CZ1 à CZ2
Elle est triée selon l'ordre croissant de la feuille source

On remet la feuille source dans le même ordre qu'elle était avant le tri
en effectuant un tri croissant sur la colonne ajoutée des numéros de lignes
et on efface la colonne ajoutée.

Ça, c'est ce que j'ai compris de ta question.

'-------------------------------------
Sub test()
Dim Rg As Range
Dim DerCol As Integer, DerLig As Long

With ThisWorkbook.Worksheets("Feuil1")
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
With .Range(.Cells(1, DerCol + 1), .Cells(DerLig, DerCol + 1))
.Formula = "=row()"
.Value = .Value
End With
Set Rg = .Range("A1", .Cells(DerLig, DerCol + 1))
End With

With Rg
.Sort Key1:=.Item(1, 1), order1:=xlAscending, Header:=xlNo
End With

'Classeur et feuille de destination
With Workbooks("classeur2").Worksheets("Feuil1")
.Range("CZ1").Resize(Rg.Rows.Count).Value = _
Rg(1, 1).Offset(, 103).Resize(Rg.Rows.Count, 1).Value
End With

With Rg
.Sort Key1:=.Item(1, .Columns.Count), order1:=xlAscending, Header:=xlNo
End With
Rg.Columns(Rg.Columns.Count).ClearContents


End Sub
'-------------------------------------
joseph84
Le #23274281
On 10 avr, 14:37, "MichD"
Bonjour,

Le principe : On ins re dans la derni re colonne le num ro des lignes
de 1 x dans la feuille source.
On trie la colonne A:A la feuille source en incluant tout le tableau

On copie dans la feuille de destination, seulement la colonne CZ1 CZ2
Elle est tri e selon l'ordre croissant de la feuille source

On remet la feuille source dans le m me ordre qu'elle tait avant le tri
en effectuant un tri croissant sur la colonne ajout e des num ros de lign es
et on efface la colonne ajout e.

a, c'est ce que j'ai compris de ta question.

'-------------------------------------
Sub test()
Dim Rg As Range
Dim DerCol As Integer, DerLig As Long

With ThisWorkbook.Worksheets("Feuil1")
    DerLig = .Cells.Find(What:="*", _
                   LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row

    DerCol = .Cells.Find(What:="*", _
                   LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column
    With .Range(.Cells(1, DerCol + 1), .Cells(DerLig, DerCol + 1))
        .Formula = "=row()"
        .Value = .Value
    End With
    Set Rg = .Range("A1", .Cells(DerLig, DerCol + 1))
End With

With Rg
    .Sort Key1:=.Item(1, 1), order1:=xlAscending, Header:=xlNo
End With

'Classeur et feuille de destination
With Workbooks("classeur2").Worksheets("Feuil1")
    .Range("CZ1").Resize(Rg.Rows.Count).Value = _
        Rg(1, 1).Offset(, 103).Resize(Rg.Rows.Count, 1).Value
End With

With Rg
    .Sort Key1:=.Item(1, .Columns.Count), order1:=xlAscending, He ader:=xlNo
End With
Rg.Columns(Rg.Columns.Count).ClearContents

End Sub
'-------------------------------------



Je suis dsl Michd mais sa fonctionne pas

je ne sais pas si avec vlookup sa va fonctionne ou pas
Publicité
Poster une réponse
Anonyme