Macro Filtre croissant tableau taille et classeur variable
Bonsoir,
Je cherche à faire une macro qui est beaucoup plus compliquée que je ne le pensais... Mes connaissances en VBA sont très mauvaises donc je commence à déprimer.
Je possède un fichier excel de plusieurs "onglets" Chaque onglet possède un tableau de taille variable (le nombre de colonne est fixe [de A à J] mais pas le nombre de ligne [de 4 à ...]) Mon Tableau est donc de forme A4 : J???
Mon objectif est de faire une macro qui me trie tout le tableau en se basant sur la colonne I (départ I4)
Il faut bien sûr que je puisse appliquer ma macro sur tous mes "onglets".
Voilà ce que j'ai pour le moment mais ça ne marche pas
Le problème est que ça fait le trie à partir de la première ligne donc ça casse mes données. En plus de ca j'ai pas l'impression que ça ne marche pas pour le "Sheet2" ..3,4,5...
Sub Tri_automatique()
With Worksheets("Sheet1")
.AutoFilterMode = False
.Range("A:J").AutoFilter
End With
Range("A:J").Sort Key1:=Range("H4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Merci d'avance pour votre aide.
Mon objectif d'après et de pouvoir faire une macro sur tous mes classeurs d'un coup!
Bonjour,
Essaie comme cela
Sub Tri_automatique()
Dim DerLig As Long
Dim Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
With Ws
Ws.Select
.AutoFilterMode = False
DerLig = .Range("I" & Rows.Count).End(xlUp).Row
.Range("A4:J" & DerLig).Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("I5:I" & DerLig) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A4:J" & DerLig)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("A4").Select
End With
Next Ws
End SubA+
Bonjour Frangy!
Ta réponse m'a beaucoup aidée.
Mille merci! C'est parfait.
J'ai voulu ajouter un peu plus de fonction à appliquer sur tous les classeurs. Je suis pas sûr de la propreté de mon code mais pour le moment ça marche
J'ai maintenant deux nouveaux objectifs:
- supprimer les doublons.
- Automatiser l'export des tableaux. En gros j'importe un fichier excel (gros tableau avec plein de données) et je veux diviser ce tableau en fonction du nom et le mettre dans un nouvelle onglet. J'ai aucune idée des fonctions qu'il faudrait utiliser....
Voilà un exemple pour illustrer ma phrase incompréhensible ^^.
Sheet1 ->
pierre 1
paul 2
jacques 12
jean 4
paul 45
jacques 2
jacques 5
jean 5
jean 6
jacques 8
Je veux avoir 4 onglet avec
pierre 1
un avec paul
paul 2
paul 45
Pour la suppression des doublons voilà le code que j'ai.
PS: Dans le code lorsqu'un "onglet" est vide il fait quand même un calcul. Je pense que ca vient de ma définition de l'intervalle: Range("H5:H" & Range("G65536").End(xlUp).Row). Comment je pourrais le définir autrement? J'ai essayé le DerLig mais il n'a pas marché...
Sub Appel()
'
' Appel Macro
'
'
Dim DerLig As Long
Dim Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
With Ws
If Ws.Name <> "Rapport" And Ws.Name <> "Entrants + Sortants" Then
Ws.Select
Range("H5").Select
ActiveCell.FormulaR1C1 = "=RC[1]-TIME(0,0,RC[-1])"
Range("H5").Select
Selection.AutoFill Destination:=Range("H5:H" & Range("G65536").End(xlUp).Row)
.AutoFilterMode = False
DerLig = .Range("I" & Rows.Count).End(xlUp).Row
.Range("A4:J" & DerLig).Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("I5:I" & DerLig) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A4:J" & DerLig)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("J4").Select
ActiveCell.FormulaR1C1 = "Temps entre 2 appels"
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-R[-1]C[-1]"
ActiveCell.Select
Selection.AutoFill Destination:=Range("J6:J" & DerLig)
Dim I as MultiThreadedCalculation
#### Range("G5:G").select #### Dans le R[I]C[6] la colonne G est sous entendue ?
I=5
If R[I]C[6]=R[I]C[-1] Then R[I]C[-1].Select
Selection.Delete Shift:=xlUp
Esle I=I+1
End If
End If
End With
Next Ws
End Sub
Merci en tout cas pour votre aide. Je commence à comprendre un peu mieux comment ça marche !!!
Bonne journée
Je ne pourrai pas beaucoup t’aider sans un classeur pour exemple.
1) Pour ce qui est de la répartition des données dans de nouveaux onglets, je n’ai rien compris à tes critères de sélection.
2) Pour ce qui est de la recherche de doublons, tu dois faire attention à la détermination de la dernière ligne renseignée.
Dans l’expression Range("H5").AutoFill Destination:=Range("H5:H" & Range("G65536").End(xlUp).Row), la dernière ligne renseignée est définie avec Range("G65536").End(xlUp).Row.
En clair, on se positionne sur la dernière ligne de la colonne G et on remonte la colonne jusqu’à trouver une cellule renseignée.
Si ta colonne G est vide, la recherche s’arrête à la ligne 1.
Ton expression devient alors Range("H5").AutoFill Destination:=Range("H5:H1")
Tu effectues une recopie incrémentée de la cellule H5 dans les cellules de la plage H1:H5.
A+
Ok merci.
Les critères sont depuis mon tableau je filtre la colonne nom pour n'en afficher qu'un. Une fois ce filtre appliqué je copie tout le tableau et je le colle dans un nouvel onglet que je nomme par le nom de la personne filtré. Je veux pouvoir faire ça pour tous les noms du tableau général.
Est ce qu'il est possible de te joindre un fichier dans un message comme ça je te montrerai une version un peu simplifiée de mon tableau.
Pour la définition des intervalles. Les fonctions .End(xlUp).Row ou End(xlDown).Row font bien descendre ou monter le calcul vers la première ligne non vide
Si à la place de
Range("H5").AutoFill Destination:=Range("H5:H" & Range("G65536").End(xlUp).Row)
Je rentre
Range("H5").AutoFill Destination:=Range("H5:H" & Range("G5").End(xlDown).Row). Ca veut bien dire qu'il se place en H5 et qu'il descend jusqu'à ce qu'il trouve la dernière ligne non vide de la colonne G en descendant.
Si la colonne G est vide il descendra jusqu'au bout de la page ?
Il faut que je rajoute un critère pour qu'il comprenne que la 5ligne du tableau est une limite à ne pas dépasser ?
Dans l'immédiat, je m'absente.
Je ne t'oublie pas et je regarderai plus tard.
A+
Est ce qu'il est possible de te joindre un fichier dans un message comme ça je te montrerai une version un peu simplifiée de mon tableau.
Tu peux joindre un fichier à ton message (onglet « Ajouter des fichiers joints »)
Il n’est pas conseillé de passer par la MP car tu te priverais de l’avis des autres intervenants.
Pour la définition des intervalles, il faut que tu adaptes ton code à la structure de tes données.
Exemple : si la ligne 4 est une ligne d’en-tête tu peux rechercher la dernière ligne renseignée avec xlUp. Il suffit d’indiquer que si la ligne trouvée est la ligne 4, il n’y a pas de données à traiter.
S’il n’y a pas de ligne d’en-tête, il suffit d’indiquer que si la ligne trouvée est la ligne 1, il n’y a pas de données à traiter.
Etc.
La solution dépend donc de la disposition de tes données.
A+
Pour mes histoires de tableau voilà un fichier excel en pièce jointe qui sert d'exemple. J'ai un tableau général qui regroupe toutes les données. Je veux pouvoir isoler les données par nom et ensuite les copier dans un nouvel onglet portant le même nom. Je pensais rajouter ces quelques lignes au tout début de ma macro ou dans une autre mais ca ne marche pas et je suis obligé de faire un code par nom ce qui me semble un peu embêtant... Surtout que les noms peuvent varier!
Dim fin As Long
Application.ScreenUpdating = False
Sheets("Sheet1").Select
AutoFilterMode = False
fin = .Range("I" & Rows.Count).End(xlUp).Row
.Range("A1:I" & fin).Select
Selection.AutoFilter
Range("B1").Select
ActiveSheet.Range("$A$1:$I" & fin).AutoFilter Field:=2, Criteria1:= _
"pierre"
Range("$A$1:$I" & fin).Select
Selection.Copy
Sheets("pierre").Select
Range("A4").Select
ActiveSheet.PastePour le reste j'ai réussi, tout marche voici d'ailleurs le code. Pour ce qui est de la définition de mes intervalles je verrai à la fin pour les optimiser, histoire de faire quelque chose de vraiment propre.
Sub Appel()
'
' Appel Macro
'
'
Dim DerLig As Long
Dim Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
With Ws
If Ws.Name <> "Rapport" And Ws.Name <> "Entrants + Sortants" Then
Ws.Select
Range("H5").Select
ActiveCell.FormulaR1C1 = "=RC[1]-TIME(0,0,RC[-1])"
Range("H5").Select
Selection.AutoFill Destination:=Range("H5:H" & Range("G65536").End(xlUp).Row)
.AutoFilterMode = False
DerLig = .Range("I" & Rows.Count).End(xlUp).Row
.Range("A4:J" & DerLig).Select
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("I5:I" & DerLig) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A4:J" & DerLig)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("J4").Select
ActiveCell.FormulaR1C1 = "Temps entre 2 appels"
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-R[-1]C[-1]"
ActiveCell.Select
Selection.AutoFill Destination:=Range("J6:J" & DerLig)
Dim i As Integer
i = 1
While i < 5
Dim rw As Object
For Each rw In Range("J6:J500")
If rw.Value < 0 Then
rw.EntireRow.Delete
End If
Next rw
Range("J6").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-R[-1]C[-1]"
ActiveCell.Select
Selection.AutoFill Destination:=Range("J6:J" & Range("I500").End(xlUp).Row)
i = i + 1
Wend
End If
End With
Next Ws
End SubEn fait je viens de me rendre compte que je me suis mal exprimé sur mon problème.
Le code du copier-coller marche mais je n'arrive pas à incrémenter le nom... Du coup pour Pierre ça marche mais pas pour jean & co.
Pour le moment je suis obligé de refaire une macro par opérateur !
La solution sur laquelle je me penche qui n'est à mon avis pas la meilleure serait de rafraîchir le tableau et recommencer la procédure. Pour le moment elle ne marche pas.
C'est Parfait ça!
Moi j'avais créé les onglet à l'avance.... Et j'avais fait une suite de procédure pour chaque nom !!!
Merci beaucoup.
Je n'ai plus de question.
Encore une fois merci beaucoup pour ton aide !