Trieuse

Bonjour à toutes et à tous,

j'ai un petit soucis, Il y a quelques temps une personne m'avais fait un super fichier avec macro, mais je ne sais pour quel raison il y a des bugs.

Pour résumer je joint un fichier sur le quel il faut faire un trie par la colonne E, puis chaque client de la colonne E doit se retrouver dans un onglet. jusque la tout va bien. mon problème est que les poids en colonne H sont complètement obsolète. et pour finir en colonne I -j-et K il se peut qu'il y ai des montant en euro comme pour le client "starlab" ex "81 €" mais déjà cela n'ai pas remis et quand ça l'est c'est en numérique hors j'en ai besoin en € .

En espérant avoir été assez clair si ce n'est pas le cas merci de revenir vers moi.

Un grand merci à celui qui m'aidera je suis en facturation ce jour et en galère.

Facturation traitement est le fichier macro qui va exploiter mes données

Facturation dentaires et le fichier a trier

Fct Dentaire est le fichier résultat qui a bugué

Bonsoir,

il n'y a aucun fichier joint, seulement une feuille vierge et un bouton de macro qui ouvre mon répertoire personnel

Poste ton fichier ouvert et on verra pour le tri.

Amicalement

Pierrot

Mince désolé javais mis deux autres fichiers mais que semble ne pas avoir été chargé

Je bais tenter de les charger à noueau.

je n'arrive pas à télécharger le fichier il dit dépasser 1 mo pourtant je n'ai laissé que 5 lignes à l’intérieur au lieu de 800 il est passé de 2.32 a 2.31 étrange non ?

Bonjour,

un fichier qui a eu à un moment une cellule occupé à la ligne 50.000 par exemple gardera TOUJOURS cette adresse et donc augmentera le poids du fichier.

Regarde s'il n'y a pas d'objets ou de graphique inutile

P.

Voici la macro

Si ça peut aider

Sub TriClients()

'

' Tri des clients sur différents onglets

'

Dim dataSheet As String

Dim ws As Worksheet

Dim leClient As String

Dim tbClients()

Dim nbClients As Integer

Dim nbLignes As Integer

Dim intChoice As Integer

Dim strPath As String

Dim MainBook As String

'

MainBook = ThisWorkbook.Name

' Ouvrir dialogue pour sélection du fichier

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

Call Application.FileDialog(msoFileDialogOpen).Filters.Clear

Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Excel file", "*.xlsx,*.xls")

intChoice = Application.FileDialog(msoFileDialogOpen).Show

'determine chix du fichier

If intChoice <> 0 Then

'si un fichier sélectionné > ouvrir

strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

Workbooks.Open (strPath)

End If

' Récupération nom feuille de données

dataSheet = ActiveSheet.Name

' Tri des données sur la colonne CLIENT

ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E2:E" & ActiveSheet.UsedRange.Rows.Count) _

, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With Worksheets(dataSheet).Sort

.SetRange Range("A1:G" & ActiveSheet.UsedRange.Rows.Count)

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

' Boucle sur la colonne CLIENT pour mémoriser leurs noms

For i = 2 To ActiveSheet.UsedRange.Rows.Count

' AND condition pour éviter le CLIENT de la ligne des totaux

If Range("E" & i).Value <> Range("E" & i - 1).Value And Not IsEmpty(Range("E" & i)) Then

nbClients = nbClients + 1

ReDim Preserve tbClients(nbClients)

tbClients(nbClients) = Range("E" & i).Value

End If

Next i

' Contrôle si Autofiltre est actif si pas ACTIVATION

Range("A2").Select

If Not ActiveSheet.AutoFilterMode Then

ActiveSheet.Range("A1").AutoFilter

End If

' Boucle sur le tableau noms clients pour filtrer - copier vers nouvelle feuille - insérer totaux

For i = 1 To nbClients

Sheets(dataSheet).Select

Selection.AutoFilter Field:=5, Criteria1:=tbClients(i)

Range("A1:L1").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

With ActiveWorkbook

Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))

If InStr(tbClients(i), "/") > 0 Then

ws.Name = Replace(tbClients(i), "/", " ")

Else

ws.Name = tbClients(i)

End If

ActiveSheet.Paste

Columns("A:L").EntireColumn.AutoFit

End With

nbLignes = ActiveSheet.UsedRange.Rows.Count

Range("G" & nbLignes + 1).FormulaR1C1 = "=SUM(R[-" & nbLignes - 1 & "]C:R[-1]C)"

Range("H" & nbLignes + 1).FormulaR1C1 = "=SUM(R[-" & nbLignes - 1 & "]C:R[-1]C)"

Range("G" & nbLignes + 1 & ":G" & nbLignes + 1).HorizontalAlignment = xlCenter

Range("A2").Select

Next i

Workbooks(MainBook).Close

End Sub

Du vba sans fichier, tu penses que c'est facile..

Perso, je renonce, désolé

P.