trie de feuille selectionné,alphabetique numerique

avoriaz

XLDnaute Junior
bonjour, le forum

voila, je voudrais rassembler sur une seul et meme feuille des données qui seront trié par ardre alphabetique et numerique.. afin de rangé les informations...

je rassemble toutes les donnée simplement sur les feuilles ayant en parti ' com ' dans l'intitulé de la feuil et seulement ceux la pas les autres .......

je voudrais eventuellement garder les doubles, et je les mets en rouges..

tous ceci sur une feuille appelé bilan

hervé m'a deja aider sur une autre option, mais je pense qu'une partie de code pourrais servir pour deja visé les feuilles ou aller chercher les donnee et pas les autres ..

Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name Like '*COM*' Then ' recherche dans les nom de feuille qui contienne le MOT 'com'

c'est pour la suite, selection de toutes les donnees dans les feuilles, les mettres dans la feuille bilan, et faire le trie, alphabetique et numerique pour rangee les lignes..

et faire apparaitre les doubles en rouges..

merci pour votre aide 'une fois de plus'

amitié

avoriaz [file name=classement_20060311103920.zip size=11475]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classement_20060311103920.zip[/file]
 

Pièces jointes

  • classement_20060311103920.zip
    11.2 KB · Affichages: 32

pat1545.

XLDnaute Accro
Salut,

essaie ceci (à peaufiner un peu )

Patrick [file name=classementAVORIAZ.zip size=21649]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classementAVORIAZ.zip[/file]
 

Pièces jointes

  • classementAVORIAZ.zip
    21.1 KB · Affichages: 34

avoriaz

XLDnaute Junior
Salut, merci pour ta reponse,

je viens de regarder, ca me conviens pour le fonnctionnement de fond ...

sauf que: tu compte a partir de la gauche ou se trouve ' com ' dans l'intitulé de la feuille ..

com n'etant pas toujours a la meme place, je peut donc pas utiliser le left(ws.name, 3)...

je dois reperer 'com' dans l'intitulé n'importe ou dans la nomination de la feuille ( onglet)

(toto com 1) ( totopope com 1) j'ai pas le meme emplacement mais com apparait donc la feuille est concerné ...

avoriaz
 

avoriaz

XLDnaute Junior
bonjour, le forum

je n'arrive pas a adapter cette macro

Sub rassemble()
Application.ScreenUpdating = False
Dim ws As Worksheet, Dep, Desti
For Each ws In Worksheets
Debug.Print ws.Name

If ws.Name Like '*COM*' Then ( par cette procedure que hervé m'avais codé pour une autre macro , je repere l'ecriture dans n'importe quel emplacement de l'intitulé de l'onglet si il ya ' com' dans l'onglet, la fauille est alors concerner par la recherche )c'est ce qu'il me faut!!!

'If UCase(Left(ws.Name, 3)) = UCase('com') Then ( ici on repere la position de com dans l'intitulé, mais le mots com n'es jamais a la meme place du coup ca marche pas !!)
'ws.Select
Range('A2').Select
Selection.CurrentRegion.Select
Set Dep = Selection
Set Desti = Sheets('bilan').Range('A65000').End(xlUp)(2)
Dep.Copy Desti
End If
Next ws
Sheets('bilan').Select
Range('A1').Value = 'com'
Range('B1').Value = 'code'
Range('C1').Value = 'libelle'
' tri
Range('A2').Select
Selection.Sort Key1:=Range('A2'), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' format condi
Range('A1').Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
'=NB.SI($A$1:$A$214;A1)>1'
Selection.FormatConditions(1).Interior.ColorIndex = 45
Selection.Copy
Range('A2').Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Application.CutCopyMode = False
Range('A1').Select
End Sub



en faite, des qu'il ya les 3 lettres com dans l'intitulé de la feuille, alors cette feuille est concerné par le trie est pas les autre feuilles... seul les feuilles du classeur portant en partie les 3 lettres com vont partie du trie /...

avoriaz
 

Hervé

XLDnaute Barbatruc
Re:trie de feuille selectionné,alphabetique numeri

Bonjur avoriaz, pat, le forum

essayes comme ceci :


Sub rassemble()
Dim ws As Worksheet
Dim Dep As Range
Dim Desti As Range
Dim c As Range
Dim plage As Range

For Each ws In Worksheets
       
If ws.Name Like '*COM*' Then
               
With ws
                       
Set Dep = .Range('A2').CurrentRegion
                       
Set Desti = Sheets('bilan').Range('A65000').End(xlUp)(2)
                        Dep.Copy Desti
               
End With
       
End If
Next ws

Sheets('bilan').Select
Range('A1').Value = 'com'
Range('B1').Value = 'code'
Range('C1').Value = 'libelle'

' tri
Range('A2').Sort Key1:=Range('A2'), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=
False, Orientation:=xlTopToBottom

Set plage = Range('a1:a' & Range('a65536').End(xlUp).Row)

For Each c In plage
       
If Application.WorksheetFunction.CountIf(plage, c) > 1 Then
                c.Interior.ColorIndex = 3
       
End If
Next c
End Sub


salut
 

avoriaz

XLDnaute Junior
Re:trie de feuille selectionné,alphabetique numeri

un grand merci, hervé & pat

ca fonctionne a merveille

avoriaz


ci joints, macro terminer permettant mon fonctionnement

option compare text

Private Sub trie()
Sheets('bilan').Cells.ClearContents
Selection.Interior.ColorIndex = xlNone
Application.ScreenUpdating = False
Dim wsk As Worksheet
Dim Dep As Range
Dim Desti As Range
Dim c As Range
Dim plage As Range

For Each wsk In Worksheets
If wsk.Name Like '*COM*' Then
With wsk
Set Dep = .Range('A2').CurrentRegion
Set Desti = Sheets('bilan').Range('A65000').End(xlUp)(2)
Dep.Copy Desti
End With
End If
Next wsk

Sheets('bilan').Select

Range('A1').Value = 'com'
Range('B1').Value = 'code'
Range('C1').Value = 'libelle'

' tri
Range('A2').Sort Key1:=Range('A2'), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set plage = Range('a1:a' & Range('a65536').End(xlUp).Row)

For Each c In plage
If Application.WorksheetFunction.CountIf(plage, c) > 1 Then
c.Interior.ColorIndex = 3
End If
Next c

' mise en ordre alph e num

Columns('A:D').Select
Selection.Sort Key1:=Range('A1'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert