Un code de ma fabrication

[Nitrog]

Bonjour à toutes et tous,

J'ai osé commettre un code pour un programme de tri de colonnes et de lignes.
Il marche extra bien, mais je me demande si il n'y a pas beaucoup de codes en trop.
Je ne peux pas mettre le fichier entier il est trop volumineux.
Je ne sais pas si vous pourriez regarder ces codes et vous faire une idée et éventuellement me proposer des améliorations.
Merci pour ce forum génial et pour votre compétence.
Nitrog [file name=code_20060407084207.zip size=8822]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/code_20060407084207.zip[/file]

 

[Gorfael]

Salut
T'aurais pu laisser un module et copier ton code dedans, ça aurait été 'plus mieux'

Range('A1').select
ActiveCell.FormulaR1C1 = '=+RC50+RC51'
Essaies
Range('A1').FormulaR1C1 = '=+RC50+RC51'

With Selection.Font
.Name = 'Arial'
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
End With
Selection.Interior.ColorIndex = xlNone
C'est pas un peu lourd ? Ne modifie que ce qui change réellement, c'est pas la peine de tout remettre à zéro à chaque fois. À la limite, si t'as peur fais-le une fois pour toutes les cellules que tu vas modifier, puis tu n'effectues que ce qui change
With Selection.
Font.Name = 'Arial'
Font.Size = 11

.VerticalAlignment = xlCenter
.Interior.ColorIndex = xlNone
End With

Par contre, tu parles de tri ? J'ai rien trouvé s'y rapportant, il me manque quelque chose ? Je n'ai que 383 lignes sur la feuille1 ?
A+

 

[Charly2]

Bonsoir Nitrog et Gorfael, bonsoir à toutes et à tous

J'ai fait une tentative pour réduire ton code, Nitrog. A toi de voir...

[file name=Nitrog_RepriseKowin.zip size=12697]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Nitrog_RepriseKowin.zip[/file]

A+

 

[Nitrog]

Bonjour Gorfael et Charly, je vous remercie pour votre aide, Charly j'ai essayé ton code, il bug à cet endroit

With Selection.Borders(xlInsideHorizontal)
?? .LineStyle = xlContinuous ??
.Weight = xlThin
End With
End With

et je n'arrive pas à corriger l'erreur, peux-tu regarder ce qu'il se passe ?

Encore merci si sa marche il aura vachement maigri.

Nitrog

 

[Charly2]

Bonjour Nitrog, bonjour Gorfael, bonjour à toutes et à tous

Oups !!! :sick:

J'ai essayé d'enlever le plus possible de .Select (pour les feuilles comme pour les cellules), mais il est possible que quelques-uns m'aient échappé :huh:

au niveau de l'erreur, tu écris :

With .Borders(xlInsideHorizontal)
  .LineStyle = xlContinuous
  .Weight = xlThin
End With

J'ai également repéré un autre bout de code avec Selection qu'il faut remplacer comme ceci :

' Titre

Rows('1:1').Insert Shift:=xlDown
Rows('1:1').RowHeight = 25

Je croise les doigts pour que le code fonctionne comme le faisait le tien

A+

 

[Nitrog]

Merci Charly, je vais essayer ce week end tes modifications et je te reviens pour te dire le résultat.

En attendant je te remercie et souhaites de bonnes fêtes de pâques à toutes et tous.

Nitrog

 

[Nitrog]

Salut Charly, j'espère que les fêtes de Paques se sont bien passées, j'ai encore des soucis, je te mets encore une ligne qui a des problèmes.
'nouvelle_feuille_BB

Workbooks.Open Filename:='C:\\KowinExcel\\bb.xls'
ThisWorkbook.Activate
Sheets('A').Visible = True
ActiveSheet.Unprotect
Range('A1:CL503').Copy
Windows('bb.xls').Activate

With Range('A1')
.PasteSpecial Paste:=xlFormats
??? .PasteSpecial Paste:=xlValues ???
.Select
End With
J'ai un peu tout essayé mais je n'arrive pas a aller plus loin.
Si tu peux m'aider ? Merci !
Nitrog

 

[Charly2]

Salut Nitrog, bonjour à toutes et à tous

J'ai Excel 97 et des possibilités restreintes par rapport aux versions plus récentes. Tu peux essayer ceci :

With Range('A1')
  .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  .Select
End With

et si ça ne fonctionne pas ou ne donne pas les résultats que tu souhaites, tu peux essayer ce code :

'nouvelle_feuille_BB

Workbooks.Open FileName:='C:\\KowinExcel\\bb.xls'
ThisWorkbook.Activate
Sheets('A').Visible = True
ActiveSheet.Unprotect
Windows('bb.xls').Activate

With Range('A1')
  ThisWorkbook.Sheets('A').Range('A1:CL501').Copy
  .PasteSpecial Paste:=xlFormats
  ThisWorkbook.Sheets('A').Range('A1:CL501').Copy
  .PasteSpecial Paste:=xlValues
  .Select
End With

J'espère qu'une des 2 solutions fera l'affaire ; tiens nous au courant.

A+

 

[Nitrog]

Salut Charly,toutes et tous,

J'ai essayé tes modifications, mais désolé de te le dire sa plante un peu, alors j'ai pris tout ce que tu as modifier qui marche et j'ai complété avec les miens, résultat plus que satisfaisant. j'ai gagné pas mal de temps lorsque je fais la macro.

Si tu le désir je peux l'annexer.

Dans tous les cas je te remercie chaleureusement pour le temps consacré.

Amicalement Nitrog