Module Mise en forme cellule ?

Version imprimable

Voir 40 message(s) de cette discussion en une page

11/10/2017, 17h50
MolikDLuffy

Je voudrais savoir si les données de la feuille PLANACTION sont effacées à chaque fois pour recopier les données de chaque feuille?
11/10/2017, 17h56
IronHeavy

Idéalement oui...

Maintenant la suppression concerne les lignes 9 à 65 536... donc épargne les lignes situées au delà!

c'est à priori par là qu'un souci peut arriver!
11/10/2017, 17h58
MolikDLuffy

les colonnes de actions de préventions doivent être copiées également dans planaction?

Je pense avoir résolu le problème

Tu verras ci-dessous, j'ai complètement modifié le code mais cela marche impeccable.

De plus, pour ton problème d'ajustement de la hauteur automatique, ça marche. Le fait que tu ne puisses pas voir tous les mots sur certaines lignes c'est à cause de l'échelle du zoom.

Si tu te mets en zoom 90% au lieu de 80%, tu verras tous les mots de la cellule.

De plus, si tu fais un aperçu avant impression, tu verras que l'on voit tout ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub test()
 
Application.ScreenUpdating = False
 
Dim feuille As Variant
Dim ligne As Long
 
Sheets("PLANACTION").Select
For ligne = 9 To 70000
If Cells(ligne, 1) = "" Then
Exit For
Else
Rows(ligne).ClearContents
End If
Next ligne
 
For feuille = 2 To Sheets.Count
For ligne = 9 To 70000
If Sheets(feuille).Cells(ligne, 1) = "" Then
Exit For
Else
Sheets("PLANACTION").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 18).Value
Sheets("PLANACTION").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 6).Value
Sheets("PLANACTION").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 5).Value
Sheets("PLANACTION").Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 11).Value
Sheets("PLANACTION").Range("E" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 12).Value
Sheets("PLANACTION").Range("F" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 14).Value
Sheets("PLANACTION").Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 17).Value
Sheets("PLANACTION").Range("H" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 19).Value
Sheets("PLANACTION").Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 20).Value
Sheets("PLANACTION").Range("J" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 21).Value
Sheets("PLANACTION").Range("K" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 22).Value
Sheets("PLANACTION").Range("L" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 23).Value
Sheets("PLANACTION").Range("M" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 24).Value
Sheets("PLANACTION").Range("N" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 25).Value
Sheets("PLANACTION").Range("O" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 26).Value
Sheets("PLANACTION").Range("P" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(feuille).Cells(ligne, 27).Value
End If
Next ligne
Next feuille
 
Sheets("PLANACTION").Select
For ligne = 9 To 70000
If Cells(ligne, 1) = "" Then
Exit For
Else
Rows(ligne).AutoFit
End If
Next ligne
 
Application.ScreenUpdating = False
End Sub

Dit moi si je ne me trompe pas.

12/10/2017, 10h26
IronHeavy
Bonjour MolikDLuffy,

de mon côté je ne vais utiliser

Code:

For feuille = 2 To Sheets.Count

car j'ai allégé le fichier original contenant près de 40 onglets! dont seulement 16 doivent alimenter le plan d'action.

Ensuite tu as laissé
Code:

1 2 Application.ScreenUpdating = False
en fin de code, je l'ai remplacé par True ! A la limite je pourrais pour le moment me passer de cette consigne pour vérifier que le code fonctionne...

Enfin un soucis, le contenu des cellules est copié et collé "à la suite" dans le plan d'action... C'est à dire que ton code supprime les cellules vides pour enchaîner avec la prochaine cellule non vide! Ce qui décale les données d'une même ligne!!

Pas glop...

edit 1 : j'adapte ce qui marche au fil de l'eau... nouveau soucis: le dernier onglet ACTIVITE est "nettoyé" : vidé de ses lignes!!

edit 2 : le classement par colonne G n'est plus là!! la hiérarchisation n'est donc plus opérationnelle...

En revanche:

- la mise en forme des cellules fonctionne bien
- la position des lignes importées est bonne, juste en dessous de l'entête.

y'a du mieux!
12/10/2017, 11h06
IronHeavy

Je pense avoir réparé ces dysfonctionnements:

Citation:

ton code supprime les cellules vides pour enchaîner avec la prochaine cellule non vide!

Citation:

le dernier onglet ACTIVITE est "nettoyé" : vidé de ses lignes

Citation:

La hiérarchisation n'est plus fonctionnelle

en mixant les 2 solutions et supprimant les lignes superflues et rajoutant la fonction de tri

Bon... voici le résultat qui répond à mes attentes:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub Hierarchisation_Click()
 
Application.ScreenUpdating = False
 
Dim Sh As Variant
Dim ligne As Long
 
With Sheets("PLANACTION")
For ligne = 9 To 70000
.Rows(ligne).ClearContents
Next ligne
 
For Each Sh In Sheets
     Select Case Sh.Name
       Case "ADMINISTRATIF", "COLLECTEDECHETS", "DDD", "ESPACESVERTS", "GYPSE", "HAUTEPRESSION", "HOSPITALIER", "HÔTELLERIE", "INDUSTRIE", "INTERHAUTEUR", "LOGISTIQUE", "MECANISE", "NETTOYAGE", "SANITAIRES", "TUNNEL", "VITRERIE"
       For lg = 9 To Sh.Range("A" & Rows.Count).End(xlUp).Row
           LgS = .UsedRange.Rows.Count + 1
           .Cells(LgS, 1) = Sh.Cells(lg, 18)
           .Cells(LgS, 2) = Sh.Cells(lg, 6)
           .Cells(LgS, 3) = Sh.Cells(lg, 5)
           .Cells(LgS, 4) = CInt(Sh.Cells(lg, 11))
           .Cells(LgS, 5) = CInt(Sh.Cells(lg, 12))
           .Cells(LgS, 6) = CSng(Sh.Cells(lg, 14))
           .Cells(LgS, 7) = CInt(Sh.Cells(lg, 17))
           .Cells(LgS, 8) = Sh.Cells(lg, 19)
           .Cells(LgS, 9) = Sh.Cells(lg, 20)
           .Cells(LgS, 10) = Sh.Cells(lg, 21)
           .Cells(LgS, 11) = Sh.Cells(lg, 22)
           .Cells(LgS, 12) = Sh.Cells(lg, 23)
           .Cells(LgS, 13) = Sh.Cells(lg, 24)
           .Cells(LgS, 14) = Sh.Cells(lg, 25)
           .Cells(LgS, 15) = Sh.Cells(lg, 26)
           .Cells(LgS, 16) = Sh.Cells(lg, 27)
       Next
 
       Case Else
 
     End Select
   Next
Rows("9:65536").Select
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range("G9") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
 
        With Worksheets("PLANACTION").Sort
        .SetRange Range("A9:P1000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 
Sheets("PLANACTION").Select
For ligne = 9 To 70000
'If Cells(ligne, 1) = "" Then
'Exit For
'Else
Rows(ligne).AutoFit
'End If
Next ligne
 
End With
End With
Application.ScreenUpdating = True
 
Sheets("PLANACTION").Activate
 
Unload UserForm1
 
End Sub

Idéalement il faudrait encore centrer le texte dans les cellules (en hauteur et en largeur) pour gagner en harmonie visuelle...

J'espère que ce code est stable et sera duplicable dans mon fichier source!

12/10/2017, 11h18
MolikDLuffy

1 pièce(s) jointe(s)
Bonjour,

Tu trouveras ci-joint le fichier avec la macro afin que tu puisses voir que ça marche.

J'ai changé False en True en fin de code pour Application.ScreenUpdate

Par contre j'ai repéré un problème de données. Pour le code NET-ELE-2, tu as en Efficacité 1625 dans PLANACTION alors qu'en réalité c'est 1.625 dans la feuille NETTOYAGE.
C'est à cause que la cellule contenant le nombre a une erreur de nombre stocké sous forme de texte dans la feuille NETTOYAGE. Il faut mettre ça en nombre pour que le copier coller marche correctement

Et dans le fichier ci-joint, tu verras que je n'ai pas de problème de ligne décalée... (sauf si je n'ai pas compris de ce que tu voulais dire)

Le code permet de supprimer toutes les lignes de la feuille PLANACTION et après de coller les éléments de chaque feuille par ligne. Si cellule vide dans une feuille et bien la boucle s'arrête et passe à une autre feuille.

Pour ta dernière feuille ACTIVITE, je ne l'ai pas dans le fichier ci-joint.

De plus, si tu as 60 feuilles mais que tu utilises que 16 feuilles pour la Macro tu dois utiliser plutôt :
Code:

1 2 For each feuille in Array(feuillex,feuilley,feuillez....)
Au lieu de :

Code:

For feuille = 2 to Sheets.Count
12/10/2017, 11h21
MolikDLuffy

Bon je vois que tu t'es débrouillé sans moi ;p

Pour centrer tes cellules, il suffit de faire ça manuellement je pense, pas besoin de code pour ça. Lorsque tu copieras les données ça se fera tout seul après puisque le format des cellules resteront
12/10/2017, 11h38
IronHeavy

Merci pour ces précisions!

Je viens de tester sur mon fichier original... C'est foireux ! 8O

mon plan d'action ressort VIERGE !!

incompréhensible!
12/10/2017, 12h03
IronHeavy

Acquis de conscience: je met mon fichier en cours en HS et reprend la version précédente...

ça marche nickel! juste la version 4.6 qui était vérolée...
12/10/2017, 13h23
MolikDLuffy

Ahhh bonne nouvelle

Parfait, je me disais bien qu'il y avait un soucis avec ton fichier.

Bonne continuation et j'espère que je ne t'ai pas embrouillé parfois avec mes codes.

Voir 40 message(s) de cette discussion en une page