Repartition de données

kolivier · 5 Septembre 2005

Bonsoir à tous et merci d'avance a tous ceux qui prendront un peu de temps pour me lire.

j'essaye de faire une macro complexe et la derniére fonction qui semble simple m'echappe totalement.

J'ai 4 feuilles dans le meme classeur, feuil0, feuil1, feuil2, feuil3

Sur la feuil0 je marque dans la cellule

A1 le chiffre 1 et dans la cellule A2 le nombre 10
B1 le chiffre 3 et dans la cellule B2 le nombre 20
C1 le chiffre 3 et dans la cellule C2 le nombre 30

En cliquant sur un bouton il faudrait que le nombre dans la cellule A2 de la feuil0 soit envoyé dans la feuil1 car la cellule A1 de la feuilO est égal à 1, et donc que les nombres présents dans les cellules B2 et C2 se retrouvent respectivement dans les cellules B2 et C2 de la feuil3 cette fois-ci.

En résumé, en cliquant sur un bouton, et fonction du chiffre contenu dans la colonne 1 de la feuil0, les infos prsentes dans la colonne 2 sont réparties dans les feuilles correspondantes.

Et comme je n'arrive pas a le faire , je n'ai malheureusement pas d'exemple a vous poposer.
Merci bcp pour votre patience.
Oliver

P.S Ce post a été aussi mis par erreur dans le salon XLD.

kolivier · 5 Septembre 2005

C'est merveileux quand meme lorsque des personnes trés sympatiques comme vous Herve et Christian acceptiez de m'aider.
Merci beaucoup pour tout.
J'ai juste un petit souci c'est que si je dois rajouter des noms par la suite et cliquer sur le bouton, il me remet deux fois les memes noms que precedemment.

Avez vous une petite idée sans trop abuser.
Merci encore

_Thierry · 5 Septembre 2005

Bonsoir Kolivier, N_Christian, Hervé, le Forum

Une Autre approche ennettoyant les Feuilles pour ton dernier problème...

Private Sub MISEAJOUR_Click()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range

With Sheets('0')
    Set Plage = .Range(.Range('B2'), .Range('B65536').End(xlUp))
End With

    For Each WS In Worksheets
          If WS.Name <> '0' Then WS.Cells.Clear
          For Each Cell In Plage
            If WS.Name = CStr(Cell) Then
                WS.Range('a65536').End(xlUp).Offset(1, 0) = Cell.Offset(0, 1)
            End If
          Next Cell
    Next WS

End Sub

Bonne Soirée
[ol]@+Thierry[/ol]

N_Christian · 5 Septembre 2005

Re: et bien voila Olivier il ne te reste plus qu'a faire le clear. je te laisse avec Hervé... trop fort

Merci Hervé pour cette exemple de boucle... c'est bien en 2D qu'il fallait penser... désolé si j'ai écorché ton appli mais je ne cerne pas bien ce type de syntaxe.... je vais y regarder tes commentaires

Bonne soirée à vous deux
Christian

kolivier · 5 Septembre 2005

Merci beaucoup HERVE pour ce dernier message. juste une derniére info, avant de vous souhaiter bonne nuit. Si comme dans l'exemple en piece jointe, je souhaite que plusieures infos sur la meme ligne et pas seulement le prénom soit envoyé sur la feuille correspondante, quelle syntaxe dois je modifiée.

Je vous rassure c'est ma derniére question aprés je ne vous embeterai plus, c'est promis.

Merci encore [file name=TEST_20050905233012.zip size=10315]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TEST_20050905233012.zip[/file]

kolivier · 5 Septembre 2005

mille pardons Thierry, je n'avais pas vu que c'était a vous que je dévais la derniére modification du fichier, donc mille merci a vous ainsi qu'a HERVE et à CHRISTIAN, car il faut le reconnaitre vous avez été trés sympa et dispo.

Avant de vous quitter, si 'lun de vous aviez une idée pour le PB suivant, je dormirai plus tranquille avant de partir au travail vers 5H

Si comme dans l'exemple en piece jointe, je souhaite que plusieures infos sur la meme ligne et
pas seulement le prénom soit envoyé sur la feuille correspondante, quelle syntaxe dois je modifiée.

Je vous rassure c'est ma derniére question aprés je ne vous embeterai plus, c'est promis.

Merci encore [file name=TEST_20050905233522.zip size=10315]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TEST_20050905233522.zip[/file]

_Thierry · 5 Septembre 2005

Re à Tous

Pas de mal Kolivier

Voici comment je procèderai sur ma base et rapidos pour ce problème de muti-colonnes à exporter :

Private Sub MISEAJOUR_Click()
Dim WS As Worksheet
Dim Plage As Range, Cell As Range

With Sheets('0')
    Set Plage = .Range(.Range('B2'), .Range('B65536').End(xlUp))
End With

    For Each WS In Worksheets
          If WS.Name <> '0' Then WS.Cells.Clear
          For Each Cell In Plage
            If WS.Name = CStr(Cell) Then
                With WS.Range('a65536').End(xlUp)
                .Offset(1, 0) = Cell.Offset(0, 1)
                .Offset(1, 1) = Cell.Offset(0, 2)
                .Offset(1, 2) = Cell.Offset(0, 3)
                End With
            End If
          Next Cell
    Next WS

End Sub

Bonne Nuit
[ol]@+Thierry[/ol]

kolivier · 5 Septembre 2005

Parfait, encore parfait et comme promis, je n'abuserai pas plus de votre gentillesse.Merci à vous trois, Merci de votre patience et de votre grande disponibilité a cette heure ci tardive.

Chapeau bas messieurs.

200/10 à vous 3 :woohoo:

Hervé · 5 Septembre 2005

re
salut thierry

afin de compléter le travail :

Private Sub MISEAJOUR_Click()
Dim ws As Worksheet
Dim i As Integer, j As Integer
Dim derligne As Integer

  For Each ws In Worksheets
          If ws.Name <> '0' Then ws.Cells.Clear
    Next ws

For i = 2 To Range('b65536').End(xlUp).Row
    With Sheets(Cells(i, 2) + 1)
        derligne = .Range('a65536').End(xlUp).Row + 1
        For j = 3 To 5
            .Cells(derligne, j - 2) = Cells(i, j)
        Next j
    End With
Next i
End Sub

bye

kolivier · 5 Septembre 2005

Merci encore pour cet autre solution HERVE maius elle me pose un léger petit PB, c'est que cela efface la premiere ligne des autres feuilles 1, 2, 3, 4 alors que celle ci ne doit pas etre effacé car ce sont des commentaires différents a chaque fois. [file name=TEST_20050905235854.zip size=11374]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TEST_20050905235854.zip[/file]

Hervé · 6 Septembre 2005

re tout le monde

Tu nous l'avais pas dit que tu avais des entêtes.

alors dans le code précédent remplace :

If ws.Name <> '0' Then ws.Cells.Clear

par

If ws.Name <> '0' Then ws.Range('a2:n100').Clear 'plage a adapter

ainsi seul la plage a2:n100 sera effacer

salut

kolivier · 6 Septembre 2005

Re bonjour le forum et bonjour à HERVE, THIERRY et Christian.

Merci Herve de ton dernier message, comme tu l'as justement indiqué j 'ai oublié de vous dire que je vouslais une entete. et ccomme j'ai encore oublié, j'aurai du te dire que je voulais une entete sur deux lignes qui ne serait jamais effacé.

J'ai essaje de changer
'derligne = .Range('a65536').End(xlUp).Row + 1
par 'derligne = .Range('a65536').End(xlUp).Row + 2'
resultat j'ai bien une entet sur deux lignes mais j'ai egalement une ligne vierge qui sépare chaque ligne du type.

vierge
vierge
Laurie
vierge
Olivier
vierge
Nicolas, etc...

Enfin j'ai juste une question apparemment c'est par incrementation aussi que les feuilles sont remplies mais si j'ai une feuille 1233 ou une feuille qui porte un nom avec des lettres, le programme ne fonctionne plus. Avez vous une idée.

Grand merci à toute personne qui pourrait lire ce message.

Hervé · 6 Septembre 2005

bonjour olivier, le forum

pour tes entetes, le code qui te permet d'effacer les feuilles avant le renvoi des données est celui-ci :

For Each ws In Worksheets
If ws.Name <> '0' Then ws.range('a2:n100').Clear
Next ws

en clair :

Pour chaque feuille du classeur
si la feuille ne s'appelle pas 0 alors efface la plage a2:n100
prochaine feuille

C'est donc ici, qu'il faut que tu adaptes ta plage à effacer : a3:n100

Pour les noms de tes feuilles, dans un précédent fil je t'avais mis en garde contre ce procédé, faut éviter de donner comme nom aux onglets des numéro 1 ,2 ,3 etc...

Si tu cahnge les noms de tes onglets, il faut bien sur que ceux-ci soit reporté dans la colonne B de ta feuille 0 et sans faute bien sur

Donc, ton code modifié devrait ressembler à ceci :

Private Sub MISEAJOUR_Click()
Dim ws As Worksheet
Dim i As Integer, j As Integer
Dim derligne As Integer

  For Each ws In Worksheets
          If ws.Name <> '0' Then ws.Range('a3:n100').Clear
    Next ws

For i = 2 To Range('b65536').End(xlUp).Row
    With Sheets(Cells(i, 2).Text)
        derligne = .Range('a65536').End(xlUp).Row + 1
        For j = 3 To 5
            .Cells(derligne, j - 2) = Cells(i, j)
        Next j
    End With
Next i
End Sub

salut

kolivier · 6 Septembre 2005

Merci beaucoup Hervé, mais comment ce fait il qu'en prenant ton avant dernier code, qui fonctionne trés bien, se met a planter des que l'on souhaite répartir une infos qui contient une longueur de texte trés longue par exemple si tu remplace prenom par tous ces caracteres 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'
en cliquant sur le bouton il me dit qu'il y a une erreur dans '
.Cells(derligne, j) = Cells(i, j)

Merci encore et désolé de revenir sur ce post

Hervé · 6 Septembre 2005

re kolivier

Sans indiscrétion, pourrais-je savoir pourquoi tu veux coller tous ces AAAAAA dans une cellule

Pour répondre à ta question : j'en sais rien :lol:

Si vraiment ceci te pose un problème je t'invite à ouvrir un autre post ou à demander l'aide de quelqu'un de plus compétant que moi dans le domaine des : AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA...

salut

Hervé · 6 Septembre 2005

re

et si eu lieu de dire des bétises je donnais la solution

essaye comme ca :

.Cells(derligne, j) = Cells(i, j).text

salut

Repartition de données

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums