bug macro

[olivier972]

Bonjour à toutes et à tous.

Voici une macro qui bug

sauriez vous m'aider svp ?
c'est la partie en gras qui bug.

Cdlt

' 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:N1").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:N").EntireColumn.AutoFit
End With
nbLignes = ActiveSheet.UsedRange.Rows.Count
Range("F" & nbLignes + 1).FormulaR1C1 = "=SUM(R[-" & nbLignes - 1 & "]C:R[-1]C)"
Range("N" & nbLignes + 1).FormulaR1C1 = "=SUM(R[-" & nbLignes - 1 & "]C:R[-1]C)"
Range("N" & nbLignes + 1 & ":N" & nbLignes + 1).HorizontalAlignment = xlCenter
Range("A2").Select
Next i
Workbooks(MainBook).Close
End Sub

Par avance un grand merci

 

[francoisC]

Bonjour, un classeur serait le bienvenu. à bientôt

 

[francoisC]

Ok Olivier je vais voir en soirée Je ne suis plus très libre maintenant à bientôt

 

[olivier972]

Ok Olivier je vais voir en soirée Je ne suis plus très libre maintenant à bientôt

Super merci prend ton temps déjà que tu m'aide c'est bien gentil
Bonne soirée

 

[francoisC]

Bonjour Olivier
Avec beaucoup de retard et d'imprévus,
Voici ma proposition.
Lis le module avant de commencer
Bien à toi,

 

[Staple1600]

Bonjour le fil, le forum

@olivier972 @francoisC
Il faudrait changer les fichiers dans vos post car ils contiennent des données confidentielles, non?
Voir ce que dit la charte.

5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant que les données soient bidons et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.

 

[Staple1600]

Bonsoir

@olivier972 et @francoisC
Vos fichiers contiennent des données confidentielles.

Vous n'avez pas vu le message#7 ?

Sinon pour ta question, une proposition de macro

Sub SplitWBK()
Dim Rng As Range, c As Range, List As New Collection, Item As Variant, ShNew As Worksheet
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("AU2", Cells(Rows.Count, "AU").End(3))
On Error Resume Next
For Each c In Rng
    List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = ActiveSheet.Range("A1:GY" & ActiveSheet.Range("C165536").End(3).Row)
For Each Item In List
Set ShNew = Worksheets.Add: ShNew.Name = Left(Trim(Item), 15)
Rng.AutoFilter 47, Item: Rng.SpecialCells(12).Copy ShNew.Range("A1"): Rng.AutoFilter
Next Item
End Sub

NB: Il faut supprimer la ligne 2 (qui est vide) avant de lancer la macro.
Test OK sur le fichier nommé:Extraction_48226v2.xlsx

 

[olivier972]

Bonsoir

@olivier972 et @francoisC
Vos fichiers contiennent des données confidentielles.

Vous n'avez pas vu le message#7 ?

Sinon pour ta question, une proposition de macro

Sub SplitWBK()
Dim Rng As Range, c As Range, List As New Collection, Item As Variant, ShNew As Worksheet
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("AU2", Cells(Rows.Count, "AU").End(3))
On Error Resume Next
For Each c In Rng
    List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = ActiveSheet.Range("A1:GY" & ActiveSheet.Range("C165536").End(3).Row)
For Each Item In List
Set ShNew = Worksheets.Add: ShNew.Name = Left(Trim(Item), 15)
Rng.AutoFilter 47, Item: Rng.SpecialCells(12).Copy ShNew.Range("A1"): Rng.AutoFilter
Next Item
End Sub

NB: Il faut supprimer la ligne 2 (qui est vide) avant de lancer la macro.
Test OK sur le fichier nommé:Extraction_48226v2.xlsx

MERCI Staple
je vais supprimer les fichier en question et merci de ton aide

 

[olivier972]

MERCI Staple
je vais supprimer les fichier en question et merci de ton aide

Staple, Pourrais tu stp me redonner la macro complete je n'arrive pas a la compiler ni à quel endroit je dois la mettre merci de ton aide
Dsl je suis une buse.