Supprimer réduire des colonnes

maval

maval

XLDnaute Barbatruc
Bonjour

Je voudrais supprimer les colonnes suivantes
"B:C,G:H,L:M,Q:R,V:W,AA:AB,AF:AG,AK:AL,AP:AQ,AU:AV,AZ:BA,BE:BF,BJ:BK,BO:BP"
Cliquez pour agrandir...

Mettre les colonnes suivantes à 25 de largeur
"D,I,N,S,X,AC,AH,AM,AR,AW,BB,BG,BL,BQ,BV,CA"
Cliquez pour agrandir...

Mettre les colonnes suivantes à 3 de largeur
"E,J,O,T,Y,AD,AI,AN,AS,AX,BC,BH,BM,BR,BW,CB"
Cliquez pour agrandir...

Et mettre les colonnes suivantes à 0.83 de largeur et colorer en rouge
"F,K,P,U:,Z,AE,AJ,AO,AT,AY,BD,BI,BN,BS,BX,CC"
Cliquez pour agrandir...


Voila le résultat avec avec l'enregistreur de macro ci-dessous. Ma question y a t-il un code plus cours

Code: 
Private Sub CommandButton1_Click()
 Range( _
        "B:C,G:H,L:M,Q:R,V:W,AA:AB,AF:AG,AK:AL,AP:AQ,AU:AV,AZ:BA,BE:BF,BJ:BK,BO:BP"). _
        Select
    Range("BO1").Activate
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    Range( _
        "B:C,G:H,L:M,Q:R,V:W,AA:AB,AF:AG,AK:AL,AP:AQ,AU:AV,AZ:BA,BE:BF,BJ:BK,BO:BP,BT:BU,BY:BZ" _
        ).Select
    Range("BY1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("AU:AU,AR:AR,AO:AO,AL:AL,AI:AI,AF:AF,AC:AC,Z:Z,W:W,T:T,Q:Q,N:N").Select
    Range("N1").Activate
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range( _
        "AU:AU,AR:AR,AO:AO,AL:AL,AI:AI,AF:AF,AC:AC,Z:Z,W:W,T:T,Q:Q,N:N,K:K,H:H,E:E,B:B" _
        ).Select
    Range("B1").Activate
    Selection.ColumnWidth = 25
    Range("C:C,F:F,I:I").Select
    Range("I1").Activate
    Columns("L:L").ColumnWidth = 2.71
    Range("C:C,F:F,I:I,L:L,O:O,R:R,U:U,X:X").Select
    Range("X1").Activate
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    Range( _
        "C:C,F:F,I:I,L:L,O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS"). _
        Select
    Range("AS1").Activate
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 33
    Range( _
        "C:C,F:F,I:I,L:L,O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS,AV:AV" _
        ).Select
    Range("AV1").Activate
    Selection.ColumnWidth = 7
    Range("AW:AW,AT:AT,AQ:AQ,AN:AN,AK:AK,AH:AH").Select
    Range("AH1").Activate
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    Range("AW:AW,AT:AT,AQ:AQ,AN:AN,AK:AK,AH:AH,AE:AE,AB:AB,Y:Y,V:V,S:S,P:P").Select
    Range("P1").Activate
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range( _
        "AW:AW,AT:AT,AQ:AQ,AN:AN,AK:AK,AH:AH,AE:AE,AB:AB,Y:Y,V:V,S:S,P:P,M:M,J:J,G:G,D:D" _
        ).Select
    Range("D1").Activate
    Selection.ColumnWidth = 0.83
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
End Sub

Cordialement

Maval
 

Pièces jointes

  • Supprime et réduit colonnes.xlsm
    19.7 KB · Affichages: 27
  • Supprime et réduit colonnes2.xls
    40 KB · Affichages: 22
Trier par date Trier par votes
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Supprimer réduire des colonnes

Bonjour maval,

Voici un code plus court en enlevant tous les "Scroll" et les lignes inutiles :
VB: 
Private Sub CommandButton1_Click()
    Range( _
        "B:C,G:H,L:M,Q:R,V:W,AA:AB,AF:AG,AK:AL,AP:AQ,AU:AV,AZ:BA,BE:BF,BJ:BK,BO:BP,BT:BU,BY:BZ" _
        ).Select
    Range("BY1").Activate
    Selection.Delete Shift:=xlToLeft
    Range( _
        "AU:AU,AR:AR,AO:AO,AL:AL,AI:AI,AF:AF,AC:AC,Z:Z,W:W,T:T,Q:Q,N:N,K:K,H:H,E:E,B:B" _
        ).Select
    Range("B1").Activate
    Selection.ColumnWidth = 25
    Range("C:C,F:F,I:I").Select
    Range("I1").Activate
    Columns("L:L").ColumnWidth = 2.71
    Range("C:C,F:F,I:I,L:L,O:O,R:R,U:U,X:X").Select
    Range("X1").Activate
    Range( _
        "C:C,F:F,I:I,L:L,O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS,AV:AV" _
        ).Select
    Range("AV1").Activate
    Selection.ColumnWidth = 7
    Range( _
        "AW:AW,AT:AT,AQ:AQ,AN:AN,AK:AK,AH:AH,AE:AE,AB:AB,Y:Y,V:V,S:S,P:P,M:M,J:J,G:G,D:D" _
        ).Select
    Range("D1").Activate
    Selection.ColumnWidth = 0.83
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
End Sub

A+
 
Vote positif 0 Vote négatif
maval

maval

XLDnaute Barbatruc
Re : Supprimer réduire des colonnes

Bonjour FredOo

Oui vraiment plus court et plus propre je te remercie beaucoup.
Juste une petite modif est-il possible pour les colonnes qui ont 7 de largeur les mettre avec le texte au centre

Merci beaucoup et bonne journée

Cordialement

Maval
 
Vote positif 0 Vote négatif
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Supprimer réduire des colonnes

Re-bonjour,

Voici la modif à apporter :
VB: 
    Range([COLOR=#800000]"AV1"[/COLOR]).Activate
    Selection.ColumnWidth = 7
    Selection.HorizontalAlignment = xlCenter

C'est la ligne "Selection.HorizontalAlignment = xlCenter" juste après l'ajustement de la colonne à 7 dans ton code.

A+
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Macro trop longue
Réponses
6
Affichages
2 K
Tirou
T
W
  • Question
Si colonne vide alors ligne suivante
Réponses
1
Affichages
1 K
Pierrot93
Pierrot93

Membres actuellement en ligne

1 membres et 95 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 486
Messages
2 110 107
Membres
110 666
dernier inscrit
Yaya123