XL 2016 supprimer colonnes

[pbruno]

Bonjour à tous,

j'aimerais supprimer les colonnes où il n'y a pas de noms sur la 1 ere ligne et si c'est possible avoir la même mise en page que sur la feuille résultat, c'est à dire ne gardant une ligne vide au dessus et une vingtaine de colonne.

Je n'arrive pas à trouver la solution.

Merci pour votre aide

 

[sylvanu]

Bonsoir Job,
La macro du post #2 marche très bien.
Le problème est autre et purement didactique. Pourquoi cette macro de Staple ne marche qu'à moitié ?

Sub Supprimer_Bis()
Rows("1:1").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
End Sub

Marche trés bien sur un fichier de test mais pas sur le fichier de Jpbruno.
Ceci dit. Bonne nuit.

 

[job75]

Mon post #14 est clair non ?

 

[sylvanu]

Re,
Non, je ne vois pas de formules en ligne 2.
Et la demande initiale est de supprimer les colonnes. Pourquoi vouloir seulement les masquer ?

j'aimerais supprimer les colonnes où il n'y a pas de noms

 

[job75]

Bonjour sylvanu, JM, le forum,

Les formules sont en WI2:WW2.

L'intérêt du masquage c'est qu'on peut le faire sur la 1ère feuille directement, voyez ce fichier (1 bis) :

Sub MAJ()
With Feuil5 'CodeName de le feuille à traiter
    If .DrawingObjects("Bouton 1").Text = "Masquer" Then
        .DrawingObjects("Bouton 1").Text = "Afficher"
        With .Range("A1", .UsedRange).Rows(1)
            .FormulaR1C1 = "=1/(COLUMN()>1)/(R[1]C="""")"
            On Error Resume Next 'si aucune SpecialCell
            .SpecialCells(xlCellTypeFormulas, 1).EntireColumn.Hidden = True 'masque les colonnes avec 1
            .ClearContents
        End With
    Else
        .DrawingObjects("Bouton 1").Text = "Masquer"
        .Columns.Hidden = False 'affiche tout
    End If
End With
End Sub

Mais si l'on veut supprimer les colonnes aucun problème, voyez ce fichier (2) :

Sub MAJ()
With Feuil7 'CodeName de le feuille de destination
    Feuil5.Cells.Copy .[A1] 'copie-colle tout
    .[A1].Copy .[A1] 'allège la mémoire
    .DrawingObjects.Delete 'supprime les objets
    With .Range("A1", .UsedRange).Rows(1)
        .FormulaR1C1 = "=1/(COLUMN()>1)/(R[1]C="""")"
        On Error Resume Next 'si aucune SpecialCell
        .SpecialCells(xlCellTypeFormulas, 1).EntireColumn.Delete 'supprime les colonnes
        .ClearContents
    End With
    With .UsedRange: End With 'actualise les barres de défilement
    .Activate 'facultatif
End With
End Sub

A+