Conserver ordre listbox lors transfert feuille

[2susy]

Bonjour à tous,
mon problème du jour c'est de conserver l'ordre apparent de ma listbox (multicolonnes dont je peux bouger les lignes à l'aide de boutons Up et Down) dans le report de données sur une feuille recap. Ce code ci-dessous me transfert systématiquement les données par ordre alpha ce que je ne veux surtout pas.

Sub Recap()
Dim x As Integer, Ligne As Long
Dim r As Integer, N As Integer
Dim cellule As Range

Set ShRe = ThisWorkbook.Sheets("Recap")
Set ShEx = ThisWorkbook.Sheets("Extraction")
For Ligne = 2 To ShEx.Range("A" & Cells.Rows.Count).End(xlUp).Row
Worksheets("Recap").Select

r = ShRe.Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
If UserForm4.ListBox8.ListCount < 1 Then Exit Sub
    For x = 0 To UserForm4.ListBox8.ListCount - 1
    For Each cellule In ShEx.Range("C" & Ligne)
    If ShEx.Range("C" & Ligne).Value = UserForm4.ListBox8.List(x) Then
    With ShRe
            .Range("A" & r).Value = ShEx.Range("A" & Ligne).Value
            .Range("B" & r).Value = ShEx.Range("B" & Ligne).Value
            .Range("C" & r).Value = ShEx.Range("C" & Ligne).Value
            .Range("D" & r).Value = ShEx.Range("D" & Ligne).Value
            .Range("E" & r).Value = ShEx.Range("E" & Ligne).Value
            .Range("F" & r).Value = ShEx.Range("F" & Ligne).Value
            .Range("G" & r).Value = ShEx.Range("G" & Ligne).Value
            .Range("H" & r).Value = ShEx.Range("H" & Ligne).Value
            .Range("I" & r).Value = ShEx.Range("I" & Ligne).Value
            .Range("J" & r).Value = ShEx.Range("J" & Ligne).Value
            .Range("K" & r).Value = ShEx.Range("K" & Ligne).Value
            .Range("L" & r).Value = ShEx.Range("L" & Ligne).Value
            .Range("M" & r).Value = ShEx.Range("M" & Ligne).Value
            .Range("N" & r).Value = ShEx.Range("N" & Ligne).Value
            .Range("O" & r).Value = ShEx.Range("O" & Ligne).Value
            .Range("P" & r).Value = ShEx.Range("P" & Ligne).Value
            .Range("Q" & r).Value = ShEx.Range("Q" & Ligne).Value
            .Range("R" & r).Value = ShEx.Range("R" & Ligne).Value
            .Range("S" & r).Value = ShEx.Range("S" & Ligne).Value
            .Range("T" & r).Value = ShEx.Range("T" & Ligne).Value
            .Range("U" & r).Value = ShEx.Range("U" & Ligne).Value
            .Range("V" & r).Value = ShEx.Range("V" & Ligne).Value
            .Range("W" & r).Value = ShEx.Range("W" & Ligne).Value
            .Range("X" & r).Value = ShEx.Range("X" & Ligne).Value
            .Range("Y" & r).Value = ShEx.Range("Y" & Ligne).Value
            .Range("Z" & r).Value = ShEx.Range("Z" & Ligne).Value
            .Range("AA" & r).Value = ShEx.Range("AA" & Ligne).Value
            .Range("AB" & r).Value = ShEx.Range("AB" & Ligne).Value
            .Range("AC" & r).Value = ShEx.Range("AC" & Ligne).Value
            .Range("AD" & r).Value = ShEx.Range("AD" & Ligne).Value
            .Range("AE" & r).Value = ShEx.Range("AE" & Ligne).Value
            .Range("AF" & r).Value = ShEx.Range("AF" & Ligne).Value
            .Range("AG" & r).Value = ShEx.Range("AG" & Ligne).Value
            .Range("AH" & r).Value = UserForm1.ComboSelect.Value
            .Range("AI" & r).Value = Date
            .Range("AJ" & r).Value = N
    N = N + 1
    End With
    End If
    Next cellule
    Next x
Next Ligne
End Sub

Merci de votre/vos aide/idées/conseils !!
Susy

 

[Guest]

Re : Conserver ordre listbox lors transfert feuille

bonjour Suzy,

Ce que tu veux c'est que dans la feuille récap soient enregistrées les lignes de ta comboBox? si oui tu peux essayer ceci:

shRe.Range("A" & r).resize(UserForm4.ListBox8.Listcount)=UserForm4.ListBox8.List(x)

La colonne (x) de la listbox sera copiée dans shRe à partir de la cellule Ar

A bientôt

 

[2susy]

Re : Conserver ordre listbox lors transfert feuille

Merci de ton aide, mais ça recopie toujours par ordre alphabétique...

 

[2susy]

Re : Conserver ordre listbox lors transfert feuille

Je viens de penser que c'est peut-être ma gestion de doublons de la feuille récap qui force l'ordre alphabétique ! Par contre la néophyte que je suis est bien incapable de discerner dans ce bout de code la partie à enlever pour empêcher l'ordre alpha...si une bonne âme pouvait m'y aider ce serait très sympa !!

With Sheets("Recap")
.Range("A2:AI" & .Range("AI65536").End(xlUp).Row).Sort Key1:=.Range("AI2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
For N = 2 To .Range("C65536").End(xlUp).Row
On Error Resume Next
  Liste.Add .Range("C" & N), CStr(.Range("C" & N))
If Err.Number <> 0 Then
  doublons = doublons & .Range("C" & N) & ","
End If
On Error GoTo 0
Next N
tablo = Split(doublons, ",")
For N = 0 To UBound(tablo)
 For M = .Range("C65536").End(xlUp).Row To 2 Step -1
If CStr(Range("C" & M)) = tablo(N) Then
If Not IsEmpty(Range("AI" & M)) Then
   x = x + 1
  If x > 1 Then Rows(M).Delete
  End If
 End If
 Next M
x = 0
Next N
End With

Merci encore!!

 

[Guest]

Re : Conserver ordre listbox lors transfert feuille

Re:

Enlève la ligne:

.Range("A2:AI" & .Range("AI65536").End(xlUp).Row).Sort Key1:=.Range("AI2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom

Cette ligne est une ligne de tri.

A bientôt

 

[2susy]

Re : Conserver ordre listbox lors transfert feuille

Bon j'ai essayé, c'est toujours pas ça...est-ce qu'une listbox est par défaut par ordre alpha??