extraction d'un classeur en plusieurs classeurs

[mycete]

Salut le forum,

J ai essayé de chercher parmi les anciens posts mais j'ai pas trouvé ce que je cherchais.

Je souhaiterais a partir d'une feuille excel extraire les données en plein de classeurs en fonction d'un critere situé par exemple colonne A

exemple en colonne A j ai un libellé non unique et je souhaite qu'automatiquement tous les lignes contenant le même critere en colonne A soit extrait dans un nouveau classeur.

Ainsi si j'ai comme libellé en colonne A : riri , fifi , riri, loulou, il me créera 3 classeurs, l un avec les données de fifi, l un avec les données de riri , et l'autre avec les données de loulou.

Bien sur il me copiera la ligne des titres pour que les données extraites soit lisibles...

Ma question est donc existe t il une macro ou une utilisation d'excel qui permette cela facilement!!

@+
Et félicitations au forum car meme si lon ny poste pas il est tres utile !!

 

[mycete]

Bonjour,

J ai retrouvé un bout de code qui m'interessait mais je solicite votre aide pour améliorer cette macro


Lien supprimé

sur le code j ai juste bidouillé le faitqu il prenne pour valeur de tri ce qui est écrit en H1

JE cherche a ce que ce tri se fasse automatiquement et qua la limite il crée un nouvel onglet ou un nouveau classeur qui porte le nom du critere de choix et ou seront stockés les données.
la macro créerai donc autant d'onglet ou fichier qu il y a de libellé différent en colonna A;Je pense qu il faut fair e un boucle mais je sais pas faire ca !!! :ermm:

comment faire pour automatiser cette extraction?

 

[mycete]

voila le code bidouillé

Le probleme c est que je n'arrive pas a extraire en autant d'onglet qu il y a de valeur différente dans la colonne selectionné !!

savez vous comment faire et éventuellement améliorer le code de création d'onglet

Sub ongletparunivers()
Application.ScreenUpdating = False

Dim cell As Range, Nom$, Sht As Worksheet
Dim base As String
Dim fin2 As Integer
Dim lettre As String
Dim numero As Integer
lettre = InputBox('lettre de la ligne des fournisseurs')
numero = InputBox('ligne des titres') + 1
fin2 = Range(lettre & numero).End(xlDown).Row
base = ActiveSheet.Name
Range(lettre & numero & ':' & lettre & fin2).Select
'fin = Selection.Rows.Count
For Each cell In Selection
Nom = cell.Value
If Nom <> '' Then
On Error Resume Next
Set Sht = Sheets(Nom)
On Error GoTo 0
If Sht Is Nothing Then Sheets.Add.Name = Nom
End If
Next cell 'fin de la créa des onglets

For i = numero To fin2 'détermination de la boucle pour coller l'entete dans chaque onglet
Nom = Worksheets(base).Range(lettre & i).Value
If Nom <> '' Then On Error Resume Next
Worksheets(base).Range('A1:' & lettre & numero - 1).EntireRow.Copy
Sheets(Nom).Activate
ActiveSheet.Range(lettre & '1').PasteSpecial
Next

For i = numero To fin2 'détermination de la boucle pour coller toutes les valeurs relative en fontion du nom
Nom = Worksheets(base).Range(lettre & i).Value
If Nom <> '' Then On Error Resume Next
Worksheets(base).Range(lettre & i).EntireRow.Copy
Sheets(Nom).Activate
ActiveSheet.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial

Next
ActiveSheet.Range('A1').Select
Application.ScreenUpdating = True

End Sub

c'est surement indigeste mais je peux peut etre essayer de vous expliquer moi ce que j ai compris de mon code