Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Tri et regrouper sur une feuille par pseudo, différentes feuilles d'un classeur...problème avec la macro

2 réponses
Avatar
fred
Bonjour,
J'ai un souci avec cette partie du code de la macro donné par JB
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value =
Sheets(s).Name
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s

J'ai des cellules contenant des commentaires avec un len de chaines de
caractères pouvant aller jusqu'à 900 - 1100 caractères
et au niveau du code de la macro
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
les valeurs sont bien reproduites...mais dès que le nbre de caractères
dépassent un certain seuil dans la cellule..je n'ai plus rien
et les valeurs des cellules deviennent = ""
Qu'est-il possible de faire??
Merci de votre aide


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
de8dfad1-bafd-4ae0-8f3c-61f2838aa172@c33g2000hsd.googlegroups.com...
Bonjour,

Sub consolide_ongletsNomOnglet()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value =
Sheets(s).Name
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

http://cjoint.com/?dpfdjc558W

JB
http://boisgontierjacques.free.fr


On 15 mar, 01:00, "fred" <fredgar...@free.fr> wrote:
> Bonjour,
> J'ai sur plusieurs feuilles d'un classeur des tableaux avec ces en-têtes :
> Feuil1
> ColA ColB C D
> Date Note Pseudo Commentaire
> 3/11 3 alizee xxxx
> 5/01 4 alizee xxxx
> 7/03 3 alizee xxxx
> 4/01 5 amoramor xxxx
> 7/02 8 janna2 xxxx
> 1/03 8 janna2 xxxx
> 10/03 5 AT xxx
> etc...
> Feuil2
> ColA ColB C D
> Date Note Pseudo Commentaire
> 12/11 3 beaufixe xxxx
> 8/01 4 beaufixe xxxx
> 14/03 3 alizee xxx
> 4/01 5 amoramor xxxx
> 14/02 8 janna2 xxxx
> etc..
> Feuil3
> Feuil4
> Feuil5 etc...
>
> A l'aide d'une macro j'aimerais trier par pseudo (en gardant la date, la
> note et le commentaire correspondant à la même ligne) les différents
> tableaux des feuilles et regrouper (copy de la feuille d'origine et
> ActiveSheet.Paste sur la FeuilTriPseudo) sur une seule feuille en ajoutant
> au tableau l'origine de la feuille.
> FeuilTriPseudo
> ColA ColB C D E
> Date Note Pseudo Commentaire Origine
> 3/11 3 alizee xxxx Feuil1
> 5/01 4 alizee xxxx Feuil1
> 7/03 3 alizee xxxx Feuil1
> 14/03 3 alizee xxxx Feuil2
> 7/02 8 janna2 xxxx Feuil1
> 1/03 8 janna2 xxxx Feuil1
> 14/02 8 janna2 xxxx Feuil2
> etc...
> En fait il faudrait récupérer les tableaux d'une quinzaine de feuilles du
> classeur!
> Merci pour votre aide!

2 réponses

Avatar
francois.forcet
On 27 mar, 12:20, "fred" wrote:
Bonjour,
J'ai un souci avec cette partie du code de la macro donné par JB
For s = 2 To Sheets.Count
      nlig = Sheets(s).[A65000].End(xlUp).Row - 1
      ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
      [A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value =
Sheets(s).Name
      [A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
      Sheets(s).[A2].Resize(nlig, ncol).Value
   Next s

J'ai des cellules contenant des commentaires avec un len de chaines de
caractères pouvant aller jusqu'à 900 - 1100 caractères
et au niveau du code de la macro
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
      Sheets(s).[A2].Resize(nlig, ncol).Value
les valeurs sont bien reproduites...mais dès que le nbre de caractères
dépassent un certain seuil dans la cellule..je n'ai plus rien
et les valeurs des cellules deviennent = ""
Qu'est-il possible de faire??
Merci de votre aide

"JB" a écrit dans le message de news:

Bonjour,

Sub consolide_ongletsNomOnglet()
   Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
   For s = 2 To Sheets.Count
      nlig = Sheets(s).[A65000].End(xlUp).Row - 1
      ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
      [A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value =
Sheets(s).Name
      [A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
      Sheets(s).[A2].Resize(nlig, ncol).Value
   Next s
   On Error Resume Next
   [A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

http://cjoint.com/?dpfdjc558W

JBhttp://boisgontierjacques.free.fr

On 15 mar, 01:00, "fred" wrote:



Bonjour,
J'ai sur plusieurs feuilles d'un classeur des tableaux avec ces en-têt es :
Feuil1
ColA ColB C D
Date Note Pseudo Commentaire
3/11 3 alizee xxxx
5/01 4 alizee xxxx
7/03 3 alizee xxxx
4/01 5 amoramor xxxx
7/02 8 janna2 xxxx
1/03 8 janna2 xxxx
10/03 5 AT xxx
etc...
Feuil2
ColA ColB C D
Date Note Pseudo Commentaire
12/11 3 beaufixe xxxx
8/01 4 beaufixe xxxx
14/03 3 alizee xxx
4/01 5 amoramor xxxx
14/02 8 janna2 xxxx
etc..
Feuil3
Feuil4
Feuil5 etc...

A l'aide d'une macro j'aimerais trier par pseudo (en gardant la date, la
note et le commentaire correspondant à la même ligne) les différen ts
tableaux des feuilles et regrouper (copy de la feuille d'origine et
ActiveSheet.Paste sur la FeuilTriPseudo) sur une seule feuille en ajouta nt
au tableau l'origine de la feuille.
FeuilTriPseudo
ColA ColB C D E
Date Note Pseudo Commentaire Origine
3/11 3 alizee xxxx Feuil1
5/01 4 alizee xxxx Feuil1
7/03 3 alizee xxxx Feuil1
14/03 3 alizee xxxx Feuil2
7/02 8 janna2 xxxx Feuil1
1/03 8 janna2 xxxx Feuil1
14/02 8 janna2 xxxx Feuil2
etc...
En fait il faudrait récupérer les tableaux d'une quinzaine de feuill es du
classeur!
Merci pour votre aide!- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


Salut fred

Je te propose le code modifié ainsi :

Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value =
Sheets(s).Name
Sheets(s).[A2].Resize(nlig, ncol).Copy
Sheets("Base").Range("A65000").End(xlUp).Offset(1,
0).Resize(nlig, ncol).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:lse, Transpose:lse
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Ton document corrigé sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200803/cijFqnw5vK.xls

Celà devrait convenir
Dis moi !!!!


Avatar
fred
Merci françois
Le code "PasteSpecial Paste:=xlPasteValues"corrige effectivement le problème
mais je dois faire attention aux dates sur la colonne A lors de la copie, je
dois mettre un format m/d/yyy dans la boucle
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
Merci beaucoup pour votre aide

a écrit dans le message de news:

On 27 mar, 12:20, "fred" wrote:
Bonjour,
J'ai un souci avec cette partie du code de la macro donné par JB
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value > Sheets(s).Name
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s

J'ai des cellules contenant des commentaires avec un len de chaines de
caractères pouvant aller jusqu'à 900 - 1100 caractères
et au niveau du code de la macro
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
les valeurs sont bien reproduites...mais dès que le nbre de caractères
dépassent un certain seuil dans la cellule..je n'ai plus rien
et les valeurs des cellules deviennent = ""
Qu'est-il possible de faire??
Merci de votre aide

"JB" a écrit dans le message de news:

Bonjour,

Sub consolide_ongletsNomOnglet()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value > Sheets(s).Name
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

http://cjoint.com/?dpfdjc558W

JBhttp://boisgontierjacques.free.fr

On 15 mar, 01:00, "fred" wrote:



Bonjour,
J'ai sur plusieurs feuilles d'un classeur des tableaux avec ces en-têtes
:
Feuil1
ColA ColB C D
Date Note Pseudo Commentaire
3/11 3 alizee xxxx
5/01 4 alizee xxxx
7/03 3 alizee xxxx
4/01 5 amoramor xxxx
7/02 8 janna2 xxxx
1/03 8 janna2 xxxx
10/03 5 AT xxx
etc...
Feuil2
ColA ColB C D
Date Note Pseudo Commentaire
12/11 3 beaufixe xxxx
8/01 4 beaufixe xxxx
14/03 3 alizee xxx
4/01 5 amoramor xxxx
14/02 8 janna2 xxxx
etc..
Feuil3
Feuil4
Feuil5 etc...

A l'aide d'une macro j'aimerais trier par pseudo (en gardant la date, la
note et le commentaire correspondant à la même ligne) les différents
tableaux des feuilles et regrouper (copy de la feuille d'origine et
ActiveSheet.Paste sur la FeuilTriPseudo) sur une seule feuille en
ajoutant
au tableau l'origine de la feuille.
FeuilTriPseudo
ColA ColB C D E
Date Note Pseudo Commentaire Origine
3/11 3 alizee xxxx Feuil1
5/01 4 alizee xxxx Feuil1
7/03 3 alizee xxxx Feuil1
14/03 3 alizee xxxx Feuil2
7/02 8 janna2 xxxx Feuil1
1/03 8 janna2 xxxx Feuil1
14/02 8 janna2 xxxx Feuil2
etc...
En fait il faudrait récupérer les tableaux d'une quinzaine de feuilles
du
classeur!
Merci pour votre aide!- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


Salut fred

Je te propose le code modifié ainsi :

Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value Sheets(s).Name
Sheets(s).[A2].Resize(nlig, ncol).Copy
Sheets("Base").Range("A65000").End(xlUp).Offset(1,
0).Resize(nlig, ncol).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Ton document corrigé sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200803/cijFqnw5vK.xls

Celà devrait convenir
Dis moi !!!!