Remonter texte dans colonne

castor30

XLDnaute Occasionnel
Bonjour le forum,
Pouvez-vous m'aider pour que je puisse "remonter" les infos saisies dans une colonne de préférence par Vba.
En vous remerciant.
 

Pièces jointes

  • Exemple.xls
    18 KB · Affichages: 42

vgendron

XLDnaute Barbatruc
Bonjour
1) supprimer les tirets
2) trier

VB:
Sub remonte()
fin = Range("E" & Rows.Count).End(xlUp).Row
Tabloinit = Range("E1:E" & fin).Value
For i = LBound(Tabloinit) To UBound(Tabloinit)
    If Tabloinit(i, 1) = "-" Or Tabloinit(i, 1) = "e_mail" Then
        Tabloinit(i, 1) = ""
    End If
Next i
Range("H1").Resize(fin) = Tabloinit


    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("H1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("H1:H" & fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
 

castor30

XLDnaute Occasionnel
Bonjour vgendron,
Heureux de te retrouver.
Il y a un problème que j'aurai du préciser, c'est que je dois absolument rester dans la même colonne.
En testant le code, changé H pour E il y a un bug à ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
En te remerciant.
 

vgendron

XLDnaute Barbatruc
Tu as du oublier un remplacement...

ceci fonctionne parfaitement
VB:
Sub remonte()
fin = Range("E" & Rows.Count).End(xlUp).Row
Tabloinit = Range("E1:E" & fin).Value
For i = LBound(Tabloinit) To UBound(Tabloinit)
    If Tabloinit(i, 1) = "-" Or Tabloinit(i, 1) = "e_mail" Then
        Tabloinit(i, 1) = ""
    End If
Next i
Range("E1").Resize(fin) = Tabloinit


    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("E1:E" & fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
 

vgendron

XLDnaute Barbatruc
et comme je sens que tu vas me dire qu'il faut commencer à la ligne 2 et garder le titre "e_mail"

VB:
Sub remonte()
fin = Range("E" & Rows.Count).End(xlUp).Row
Tabloinit = Range("E2:E" & fin).Value
For i = LBound(Tabloinit) To UBound(Tabloinit)
    If Tabloinit(i, 1) = "-" Then
        Tabloinit(i, 1) = ""
    End If
Next i
Range("E2").Resize(fin - 1) = Tabloinit


    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("E2:E" & fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
 

castor30

XLDnaute Occasionnel
Re,
Il y a un problème ici :
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear

viewer.php
http://zupimages.net/viewer.php?id=17/45/j5ks.jpg
 

castor30

XLDnaute Occasionnel
Avec l'enregistreur c'est OK, mais la longueur de la colonne sera variable
Code :
Sub Macro1()
'
[E2:E87].Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E2:E11").Select
Selection.ClearContents
Range("E12:E24").Select
Selection.Cut Destination:=Range("E2:E14")
Range("E2:E14").Select
End Sub
 

vgendron

XLDnaute Barbatruc
d'où la variable "fin"

essaie ceci
VB:
Sub remonte()
fin = Range("E" & Rows.Count).End(xlUp).Row
Tabloinit = Range("E2:E" & fin).Value
For i = LBound(Tabloinit) To UBound(Tabloinit)
    If Tabloinit(i, 1) = "-" Then
        Tabloinit(i, 1) = ""
    End If
Next i
Range("E2").Resize(fin - 1) = Tabloinit

Range("E2").Resize(fin - 1).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'
'ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
'ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E2"), _
'    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
'    xlSortTextAsNumbers
'With ActiveWorkbook.Worksheets("Feuil1").Sort
'    .SetRange Range("E2:E" & fin)
'    .Header = xlNo
'    .MatchCase = False
'    .Orientation = xlTopToBottom
'    .SortMethod = xlPinYin
'    .Apply
'End With

End Sub

après. si ca ne marche toujours pas, bah désolé. je ne peux plus rien.. à toi d'adapter le code
 

Discussions similaires

Réponses
3
Affichages
345

Statistiques des forums

Discussions
312 103
Messages
2 085 324
Membres
102 862
dernier inscrit
Emma35400