VBA supprimer colonne

[deb_38]

Bonjour à tous,

Je souhaite écrire une macro qui, si la colonne A n'est cochée, elle récupère le nom d'à côté, supprime la ligne entière portant ce nom, et la colonne entière portant ce nom, avec une boucle.

Voici mon fichier pour mieux comprendre.

Je voudrais pouvoir supprimer "Stephane" et "Suzie" sur l'exemple.
Merci de votre aide.

 

[Johan]

Salut deb_38,


Que penses-tu du code suivant ?

Sub DeleteRowAndColumn()

Dim nom As String
Dim derLigne As Long
'derLigne = ThisWorkbook.Sheets("Données").Range("A4").End(xlUp).Row + 1

For Each Cell In Sheets("Données").Range("A4:A7")
    If Cell <> "x" Then
        nom = Cell.Offset(0, 1).Value
        MsgBox nom
        Cell.EntireRow.Delete
    With Range("A2:F2")
        Set nomColonne = .Cells.Find(nom)
        nomColonne.EntireColumn.Delete
    End With
    End If
Next Cell

End Sub

A tester

Johan

 

[deb_38]

Merci Johan
J'ai testé ton code, sauf que ça supprime un seul élément à la fois.
Est ce qu'il y a moyen de les supprimer tous en même temps ?

 

[phlaurent55]

Bonjour à tous,

Sub DeleteRowAndColumn()

For i = Range("B65535").End(xlUp).Row To 4 Step -1
    If Cells(i, 1) <> "x" Then
        nom = Cells(i, 2)
        Rows(i).EntireRow.Delete
    For Each cellule In Range("C2:F2")
        If cellule = nom Then Columns(cellule.Column).EntireColumn.Delete
    Next cellule
    End If
Next i

End Sub

à+
Philippe

 

[pierrejean]

Bonjour a tous
Une autre version
La macro est déclenchée par l'activation de la feuille Résultats

 

[deb_38]

Merci à vous tous

 

[job75]

Bonjour à tous,

Comme je passe par là voici une macro sans boucle :

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
With Sheets("Données")
    .Range("A1", .UsedRange).Copy [A1]
End With
On Error Resume Next 'si aucune SpecialCell
Range("A4:A" & Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With Rows(2).SpecialCells(xlCellTypeConstants).Offset(1) 'ligne 3 auxiliaire
    .Formula = "=1/ISTEXT(INDEX($A:$A,MATCH(C2,$B:$B,0)))"
    .SpecialCells(xlCellTypeFormulas, 16).EntireColumn.Delete
    .ClearContents
End With
End Sub

Il y a cependant des condition :

- les noms en ligne 2 doivent correspondre aux noms en colonne 2, sans doublons.

- ils peuvent être dans n'importe quel ordre mais sans cellule vide intercalée.

Fichier joint.

A+