Effacer certaines données

Le
Richard G.
Bonjour,

J'ai une feuille avec des données réparties de la façon suivante :

TOTAL Blabla Blabla TOTAL Blabla Blabla Blabla
49 36 13 22 13 9
69 52 17 28 17 11
78 36 42 53 42 11
61 32 29 57 29 28

TOTAL Blabla Blabla Blabla TOTAL Bli Blabla
49 36 13 13 13
69 52 17 17 17
62 40 22 22 22

Je cherche à effacer la cellule contenant le mot "total" ainsi que les
données qui se trouvent en dessous, sans toutefois supprimer toute la
colonne. Je voudrais ensuite combler l'espace laissé vide par cet
effacement en décalant les données situées à droite (couper/coller).
En bref, je dois faire disparaître les sous-totaux, en sachant qu'il
ne se situent pas tous dans la même colonne.

Voici le code que j'ai conçu, mais qui ne marche pas vraiment :

Range("B1").Select
For Each c In Range("B1:K300")
If InStr(c.Value, "TOTAL") <> 0 Then
Range(Selection, Selection.End(xlDown)).ClearContents
ActiveCell.Offset(, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
ActiveCell.Offset(, -1).Select
ActiveSheet.Paste
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
Next

Merci par avance pour vos lumières !

A bientôt,
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel
Le #4358741
Bonjour.
Essaie :

Sub test()
Set c = ActiveSheet.UsedRange.Find("TOTAL", , , xlWhole)
Do While Not c Is Nothing
Range(c, c.End(xlDown)).Delete xlShiftToLeft
Set c = ActiveSheet.UsedRange.Find("TOTAL", , , xlWhole)
Loop
End Sub

Cordialement.
Daniel
"Richard G."
Bonjour,

J'ai une feuille avec des données réparties de la façon suivante :

TOTAL Blabla Blabla TOTAL Blabla Blabla Blabla
49 36 13 22 13 9
69 52 17 28 17 11
78 36 42 53 42 11
61 32 29 57 29 28

TOTAL Blabla Blabla Blabla TOTAL Bli Blabla
49 36 13 13 13
69 52 17 17 17
62 40 22 22 22

Je cherche à effacer la cellule contenant le mot "total" ainsi que les
données qui se trouvent en dessous, sans toutefois supprimer toute la
colonne. Je voudrais ensuite combler l'espace laissé vide par cet
effacement en décalant les données situées à droite (couper/coller).
En bref, je dois faire disparaître les sous-totaux, en sachant qu'il
ne se situent pas tous dans la même colonne.

Voici le code que j'ai conçu, mais qui ne marche pas vraiment :

Range("B1").Select
For Each c In Range("B1:K300")
If InStr(c.Value, "TOTAL") <> 0 Then
Range(Selection, Selection.End(xlDown)).ClearContents
ActiveCell.Offset(, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
ActiveCell.Offset(, -1).Select
ActiveSheet.Paste
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
Next

Merci par avance pour vos lumières !

A bientôt,
AH60
Le #4358721
Bonjour

Sub EffaceCol()
Dim Col As Integer
With Worksheets("Feuil1")
Col = Application.Match("TOTAL", Rows(1), 0)
.Columns(Col).ClearContents
.Columns(Col + 1).Copy .Columns(Col)
End With
End Sub

Abed_H




Bonjour,

J'ai une feuille avec des données réparties de la façon suivante :

TOTAL Blabla Blabla TOTAL Blabla Blabla Blabla
49 36 13 22 13 9
69 52 17 28 17 11
78 36 42 53 42 11
61 32 29 57 29 28

TOTAL Blabla Blabla Blabla TOTAL Bli Blabla
49 36 13 13 13
69 52 17 17 17
62 40 22 22 22

Je cherche à effacer la cellule contenant le mot "total" ainsi que les
données qui se trouvent en dessous, sans toutefois supprimer toute la
colonne. Je voudrais ensuite combler l'espace laissé vide par cet
effacement en décalant les données situées à droite (couper/coller).
En bref, je dois faire disparaître les sous-totaux, en sachant qu'il
ne se situent pas tous dans la même colonne.

Voici le code que j'ai conçu, mais qui ne marche pas vraiment :

Range("B1").Select
For Each c In Range("B1:K300")
If InStr(c.Value, "TOTAL") <> 0 Then
Range(Selection, Selection.End(xlDown)).ClearContents
ActiveCell.Offset(, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
ActiveCell.Offset(, -1).Select
ActiveSheet.Paste
ActiveCell.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
Next

Merci par avance pour vos lumières !

A bientôt,




Publicité
Poster une réponse
Anonyme