Extaire et copier sur une autre feuille

[ALF76490]

Bonjour à toutes et à tous =),

Petit soucis avec un tableau Excel dans lequel je n'arrive pas extraire les données des ligne suivant une variable (la variable étant le code client) commune pour pouvoir traiter ces données.

Je vous joint un fichier pour vous éclairer un peu plus
Le but est d'extraire les données du tableau principal de manière à avoir une feuille pour chaque client et ensuite pouvoir traiter les données sans problèmes (exemple CA du client)

Merci beaucoup.

 

[ALF76490]

Re : Extaire et copier sur une autre feuille

Avec la pièce jointe c'est mieux !!!!

 

[Staple1600]

Re : Extaire et copier sur une autre feuille

Bonjour ALF76490, le fil, le forum

Essaie ce code (que j'avais proposé dans Lien supprimé jadis)

EDITION: après avoir fait pénitence, voici un code amendé testé et fonctionnel.

Sub eclater_test_ok()
Dim dl&, dc&, i&, pl&, dlc&, ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
    dl = .Cells(Rows.Count, "A").End(-4162).Row
    dc = .Cells(1, Columns.Count).End(-4159).Column
    .Range(.Cells(2, 1), Cells(dl, dc)).Sort Key1:=Range("F2"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    pl = 2
    For i = 2 To dl
    If .Range("F" & i).Value <> .Range("F" & i + 1).Value Then
    dlc = i: Sheets.Add after:=Sheets(Sheets.Count): Set ws = ActiveSheet
        On Error Resume Next
         ws.Name = .Cells(pl, "A").Text
        On Error GoTo 0
        ws.Range(Cells(1, 1), Cells(1, dc)).Value = _
        .Range(.Cells(1, 1), .Cells(1, dc)).Value
        .Range(.Cells(pl, 1), .Cells(dlc, dc)).Copy ws.Range("A2")
        pl = dlc + 1
    End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[ALF76490]

Re : Extaire et copier sur une autre feuille

Bonjour Staple1600,

Merci pour votre réponse.
Cependant, lorsque j'effectue le code il m'eclate le fichier (noter que j'aimerias bien garder ma base) mais non pas par client mais par n° de commande. De plus il me renvoi la meme ligne à chaque fois.

Je me permet de joindre le résultat obtenu.

Encore Merci

Nota : notez que je débute en macro, Merci

 

[Staple1600]

Re : Extaire et copier sur une autre feuille

Re

EDITION 3:

L'erreur dans le code précédent à été corrigé

(Ce message a donc été édité)

 

[david84]

Re : Extaire et copier sur une autre feuille

Bonjour, re-salut staple,
ci-joint une possibilité formule avec menu déroulant permettant la sélection du code, sous réserve d'avoir compris ta demande (ce qui n'est pas sûr).
Tu peux soit travailler sur une seule feuille en sélectionnant le code, soit copier les feuille autant de fois que nécessaire et sélectionner un code différent par feuille.
Les nouveaux codes sont automatiquement inclus dans le menu déroulant.
A+

 

[Guest]

Re : Extaire et copier sur une autre feuille

Bonjour,

Alf, voici un fichier qui crée une feuille par code client avec les données lui appartenant.

Si tu veux que le nom des feuilles soit celui du client et non son code, dis le.

@Staple, tu feras trois fois le tours du pâté de maison, pour ta punition
Pas de contrition mon ami. Je passerai mon temps à ça sinon.
A++

A+ à tous

 

[ALF76490]

Re : Extaire et copier sur une autre feuille

bonjonr David et merci beaucoup,

Le resultat obtenu est exctaement celui que je voulais.
Pour répondre à ta question sur le nom du client, oui cela m'interesse.
Si je puis me permettre, et cela dans la mesure de votre gentillesse, étendre la macro. Cela fais plus de deux jours que je galère pour me demer..... seul.

Le projet est le suivant ,

Chaque moi j'extrait de notre system de gestion la CA de mon service.

Pour eviter toute erreur j'extrait le Ca depuis le début de l'année, donc fichier identique avec incrémentation des commandes en cours et commandes facturées.

Après avoir exécuté, ta macro (magnifique pour moi !!!) je vais regarder le CA de chaque, client-est-il en visageable d'avoir le resultat cela sous une macro dans une feuille seul avec pour seul donnée le Nom du client et son CA).

Ensuite j'aimerais avoir les statistiques des prouits (par classements du plus vendu au moin vendu)

En fait l'idee est la suivante :

Feuille 1 : Macro avec bouton pour le mise en forme puis menu deroulante avec l'ensemble des clients pour un accés rapide (envrion 500 clients dans le monde)
Feuille 2 : CA global de chaque client
Feuille 3 et +++ : Détail des commandes clients

Juste pour info je n'ais extrait qu'un parti de mon tableur (environ 6000 lignes par ans).

Et encore merci a toute l'équipe pour ce que vous faites !

Cordialement

ps : merci d'être indulgent avec staple1600 même si la macro a planté mon pc !!!! lol

 

[david84]

Re : Extaire et copier sur une autre feuille

Re,
la solution que je t'ai apportée n'est pas une macro, c'est une formule.
Si tu veux obtenir la même chose par macro, je ne peux rien pour toi mais les collègues VBAistes pourront te fournir le même résultat.
A+

 

[Guest]

Re : Extaire et copier sur une autre feuille

Re,

Plus bas la macro corrigée. Je joint un nouveau fichier car la structure de la feuille cachée "tmp" a changé.

@Alf, je précise que nous ne sommes pas sur un forum de développement d'application mais d'échange.

J'ai répondu largement à ta question et m'en tiendrait là pour ce fil de discussion.

Pour les autres questions, fais des essais à partir de ce que tu comprends et ouvre un nouveau fil par question différente avec tes bouts d'éssai.

Dans la rédaction de tes demandes essai d'être plus clair, ton dernier post est vague.

[COLOR=blue]Sub[/COLOR] ExtraireClients()
    [COLOR=blue]Dim[/COLOR] sh [COLOR=blue]As[/COLOR] Worksheet, shTmp [COLOR=blue]As[/COLOR] Worksheet, shDatas [COLOR=blue]As[/COLOR] Worksheet
    [COLOR=blue]Dim[/COLOR] clients
    [COLOR=blue]Dim[/COLOR] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]Set[/COLOR] shDatas = Sheets([I]"Feuil1"[/I])
    [COLOR=blue]Set[/COLOR] shTmp = Sheets([I]"tmp"[/I])
    [COLOR=green]'Nettoyage des anciennes données éventuelles[/COLOR]
    shTmp.Range([I]"A1"[/I]).CurrentRegion.ClearContents
    [COLOR=green]'Extraction des clients unique[/COLOR]
    shDatas.Columns([I]"F:G"[/I]).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=shTmp.Range([I]"A1"[/I]), _
            Unique:=[COLOR=blue]True[/COLOR]
    [COLOR=green]'Conserver les valeurs de la liste des clients[/COLOR]
    [COLOR=blue]With[/COLOR] shTmp
        clients = .Range([I]"A1:B"[/I] & .Cells(.Rows.Count, 1).[COLOR=blue]End[/COLOR](xlUp).Row).Value
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
    [COLOR=green]'Vérifier qu'[COLOR=blue]on[/COLOR] a bien extrait une liste[/COLOR]
    [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] IsArray(clients) [COLOR=blue]Then[/COLOR]
        MsgBox [I]"La macro d'extraction n'a pas trouvé la liste des clients en "[/I] & shDatas.Name & [I]"!F:G"[/I], vbExclamation, [I]"Extraction des clients"[/I]
        [COLOR=blue]Exit[/COLOR] [COLOR=blue]Sub[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]For[/COLOR] i = 2 To [COLOR=blue]UBound[/COLOR](clients)
 
        [COLOR=green]'Vérifier que le clients n à bien un code[/COLOR]
        [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] IsEmpty(clients(i, 1)) [COLOR=blue]Then[/COLOR]
            [COLOR=green]'Nettoyage des ancienne données[/COLOR]
            shTmp.Range([I]"H1"[/I]).CurrentRegion.ClearContents
            [COLOR=green]'Renseigner la plage de critère d'extraction[/COLOR]
            shTmp.Range([I]"E2"[/I]) = clients(i, 1)
            [COLOR=green]'Extraction des données  du client en cours de la feuille Feuil1 vers la feuille [I]"tmp"[/I] (cachée)[/COLOR]
            shDatas.Range([I]"A1"[/I]).CurrentRegion.AdvancedFilter _
                    Action:=xlFilterCopy, _
                    CriteriaRange:=shTmp.Range([I]"E1:E2"[/I]), _
                    CopyToRange:=shTmp.Range([I]"H1"[/I]), _
                    Unique:=[COLOR=blue]False[/COLOR]
            [COLOR=green]'Si l'extraction a renvoyé plus d'une ligne[/COLOR]
            [COLOR=blue]If[/COLOR] shTmp.Range([I]"E1"[/I]).CurrentRegion.Rows.Count > 1 [COLOR=blue]Then[/COLOR]
 
                [COLOR=green]'ajouter une feuille[/COLOR]
                [COLOR=blue]Set[/COLOR] sh = Worksheets.Add(after:=Sheets(Sheets.Count))
 
                [COLOR=green]'puis lui donner le nom du client ou son code si le nom est vide[/COLOR]
                [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] IsEmpty(client(1, 2)) [COLOR=blue]Then[/COLOR] sh.Name = clients(i, 2) [COLOR=blue]Else[/COLOR] sh.Name = clients(1, 1)
 
                [COLOR=green]'Mettre dans la feuille les données extraites et qui se trouve en H sur la feuille 'tmp'[/COLOR]
                shTmp.Range([I]"E1"[/I]).CurrentRegion.Copy sh.Range([I]"A1"[/I])
 
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

A+

 

[ALF76490]

Re : Extaire et copier sur une autre feuille

Merci bcq Hasco et désolé d'avoir abusé, mais au vu de votre efficacité je me suis enflammé.

cependant juste une remarque sur la dernière macro car elle bloque sur la ligne suivante :

If Not IsEmpty(client(1, 2)) Then sh.Name = clients(i, 2) Else sh.Name = clients(1, 1)

Merci de ton aide

Cordialement

 

[Guest]

Re : Extaire et copier sur une autre feuille

Re,

cependant juste une remarque sur la dernière macro car elle bloque sur la ligne suivante

Oui, mais encore? Quel message d'erreur?

je suppute qu'il manque le 's' final à 'Client'. J'ai oublié de les mettre quand j'ai modifié la macro.

encore une fois essaie de comprendre, vérifie les variables, leur contenu quand il y a erreur.

A+

 

[Staple1600]

Re : Extaire et copier sur une autre feuille

Re

EDITION: voila je suis be back
J'ai édité le message avec le code VBA qui désormais fonctionne
Désolé pour le désagrément causé.

Merci à Hasco d'être passé par ici
Cela fait plaisir de voir des neurones fonctionnels, prompts et réactifs.
(avec en plus des commentaires et les couleurs du code idoines )

Finalement en lieu et place de placard, je suis allé à la piscine

I will be back, avec un code corrigé et fonctionnel.

PS: mon code est certes erratique mais pas au point de planter un PC.
En tout cas, celui sur lequel j'ai testé mon code "foireux" est toujours de ce monde.
PS2: Étant en rase campagne , il y a point de pâté de maison aux alentours.
Je vais faire une fois le tour du forum ( mais en quelques années)