XL 2010 code VBA pour trier une colonne de mon tableau

Michelrib

XLDnaute Nouveau
Sub ajouterAnnuaire()
'
' ajouterAnnuaire Macro
'
Sheets("ANNUAIRE").Select
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A3").Select
Sheets("FORMULAIRE").Select
Range("F7").Select
Selection.Copy
Sheets("ANNUAIRE").Select
ActiveSheet.Paste
Range("B3").Select
Sheets("FORMULAIRE").Select
Range("I7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANNUAIRE").Select
ActiveSheet.Paste
Range("C3").Select
Sheets("FORMULAIRE").Select
Range("F10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANNUAIRE").Select
ActiveSheet.Paste
Range("D3").Select
Sheets("FORMULAIRE").Select
Range("I10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANNUAIRE").Select
ActiveSheet.Paste
Range("E3").Select
Sheets("FORMULAIRE").Select
Range("F13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANNUAIRE").Select
ActiveSheet.Paste
Range("F3").Select
Sheets("FORMULAIRE").Select
Range("I13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANNUAIRE").Select
ActiveSheet.Paste
Sheets("FORMULAIRE").Select
Range("F16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANNUAIRE").Select
Range("G3").Select
ActiveSheet.Paste
Sheets("FORMULAIRE").Select
Range("F16,F13,F10,F7,I7,I10,I13").Select
Range("I13").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("F7").Select
Sheets("ANNUAIRE").Select
Range("A3:G3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Sheets("FORMULAIRE").Select
ActiveWindow.SmallScroll Down:=3
'trier par ordre alphabétique

End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour et bonne année @Michelrib :) (et à @danielco aussi ;))

Le titre d'une discussion n'est pas le corps du message.
Le titre doit indiquer et évoquer en quelques mots le sujet de la question.

C'est dans le corps du message qu'on fait sa prose, pas dans le titre.

Il est encore temps de modifier votre message en raccourcissant drastiquement le titre de la discussion pour indiquer le détail de la question dans le corps de votre message. Merci :).
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @Michelrib,

Franchement, nous fournir un petit fichier exemple aurait été apprécié.
Essayez ce code :
VB:
Sub ajouterAnnuaire()
Dim FormulR As Worksheet, derlig As Long
   Set FormulR = Sheets("FORMULAIRE")
   With Sheets("annuaire")
      .Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      FormulR.Range("f7").Copy .Range("a3")
      FormulR.Range("i7").Copy .Range("b3")
      FormulR.Range("f10").Copy .Range("c3")
      FormulR.Range("i10").Copy .Range("d3")
      FormulR.Range("f13").Copy .Range("e3")
      FormulR.Range("i13").Copy .Range("f3")
      FormulR.Range("f16").Copy .Range("g3")
      FormulR.Range("F16,F13,F10,F7,I7,I10,I13").ClearContents
      .Range("A3:G3").Borders.LineStyle = xlLineStyleNone
      .Range("A3:G3").Borders.LineStyle = xlContinuous
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
      .Range("a3:g" & derlig).Sort key1:=.Range("a3"), order1:=xlAscending, MatchCase:=False, Header:=xlNo
   End With
End Sub
 
Dernière édition:

Michelrib

XLDnaute Nouveau
Re @Michelrib,

Franchement, nous fournir un petit fichier exemple aurait été apprécié.
Essayez ce code :
Code:
Sub ajouterAnnuaire()
Dim FormulR As Worksheet, derlig As Long
   Set FormulR = Sheets("FORMULAIRE")
   With Sheets("annuaire")
      .Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      FormulR.Range("f7").Copy .Range("a3")
      FormulR.Range("i7").Copy .Range("b3")
      FormulR.Range("f10").Copy .Range("c3")
      FormulR.Range("i10").Copy .Range("d3")
      FormulR.Range("f13").Copy .Range("e3")
      FormulR.Range("i13").Copy .Range("f3")
      FormulR.Range("f16").Copy .Range("g3")
      FormulR.Range("F16,F13,F10,F7,I7,I10,I13").ClearContents
      .Range("A3:G3").Borders.LineStyle = xlContinuous
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
      .Range("a3:g" & derlig).Sort key1:=.Range("a3"), order1:=xlAscending, MatchCase:=False, Header:=xlNo
   End With
End Sub
 

Discussions similaires