Supprimer cellules et non lignes

Bonjour à tous,

Voici mon script ci-dessous :

MonClasseur = ActiveWorkbook.Name
Set fb = Sheets("Base")
Set ft = Sheets("Trimestriel")

Set Ws = ActiveWorkbook.Worksheets("Base")
derln1 = fb.Range("B" & Rows.Count).End(xlUp).Row

' Copier la feuille dans un nouveau classeur
Sheets("Base").Copy
With ActiveWorkbook.ActiveSheet
.Name = "Samples Request"
On Error Resume Next ' Si aucune ligne vide
.Shapes("Request").Delete
.Range("D14:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

On Error GoTo 0
End With
For i = 5 To fb.Range("B" & Rows.Count).End(xlUp).Row
ft.Range("D" & i) = ft.Range("D" & i) + fb.Range("D" & i)
ft.Range("D" & i) = IIf(ft.Range("D" & i) = 0, "", ft.Range("D" & i))
Next i
Workbooks(MonClasseur).Activate
Worksheets("Base").Activate
Columns("D:D").ClearContents
Columns("H:H").ClearContents
Range("C1:C9,G1:G9").ClearContents
Range("F195:H202").ClearContents
ActiveSheet.Range("E17").Select
End Sub

Il fonctionne bien mais j'aimerais le modifier car je vais apporter des modifications au fichier aussi.

Pour la formule .Range("D14:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete qui supprime les lignes entières je voudrais seulement supprimer les cellules des colonnes de B à D qui n'ont pas l'objet d'un marquage.

Comment faire ?.

En PJ mon fichier modifié d'origine et avec les modifications.

Merci

En fait l'idée de supprimer les lignes entre les colonnes B et D qui n'ont pas fait l'objet d'un marquage.

Merci de votre aide.

Salut Rom,

Si j'ai bien compris, tu souhaites nettoyer les cellules qui ne font pas l'objet d'un marquage ?

For Each Cel In .Range("D14:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Cel.ClearContents
Next Cel

Salut Baboutz,

En fait j'ai oublié d'être clair : c'est un fichier qui permets au commercial de sélectionner les besoins des clients.

Pour cela il rempli en numéraire les quantités nécessaires pour les references souhaitées.

Après il clique sur le bouton "Request" et la macro se met à travailler :

- Une autre feuille excel se crée

- Seules les references demandées apparaissent mais celles qui ne le sont pas disparaissent d'où :

Range("D14:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Par contre, dans ce cas la macro supprime les lignes entièrement.

La macro fonctionne parfaitement sur mon fichier d’origine car toutes les refrences sont les unes sous les autres, colonne B à D.

Dans un souci d'économie j'ai remonté des references sur d'autres colonnes (F à G), sur le fichier modifié.

Du coup :

Range("D14:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

supprime les lignes des references non marquées des colonnes B à D et aussi celles des colonnes F à G comme elles sont sur la même ligne.

Il faudrait que je puisse seulement supprimer les cellule des références non marquées des colonnes B à D et F à G.

Comme sur un ficher excel : tu sélectionnes des cellules, clique droit, supprimer, et tu choisis entre un décalage vertical ou horizontal. Dans mon cas c'est vertical.

Si je ne me trompe pas ce que tu me proposes supprime le contenu des cellules mais ne les supprime pas ?

J’espère que c'est plus claire maintenant.

Il y a un compteur sur la macro mais pas besoin de le toucher.

Merci

Re,

Dans ce cas utilise :

.Delete Shift:=xlUp 'Ou xlLeft

Je ne suis plus au travail.

Si je comprends bien j'utiliserai :

.Range("B14:D800").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

Je tiens au courant lundi

Merci et bon week end

Il te faudra surement faire une boucle et faire plutôt un truc du genre :

For Each Cel In .Range("B14:B800").SpecialCells(xlCellTypeBlanks)

    .Range("B" & Cel.Row & ":D" & Cel.Row).Delete Shift:=xlUp

Next Cel

Salut Baboutz,

J'ai fait les modifs:

' Copier la feuille dans un nouveau classeur
    Sheets("Base").Copy
    With ActiveWorkbook.ActiveSheet
        .Name = "Samples Request"
        On Error Resume Next  ' Si aucune ligne vide
        .Shapes("Request").Delete
        For Each Cel In .Range("B14:B800").SpecialCells(xlCellTypeBlanks)
        .Range("B" & Cel.Row & ":D" & Cel.Row).Delete Shift:=xlUp
    Next Cel

Mais rien ne fonctionne.

J'ai bien essayé de passer par la fonction "Columns" mais je n'ai pas trouvé l'astuce.

Aurais-tu une autre idée ?

Salut Rom,

Voici un code à tester chez toi, fonctionnel chez moi :

    'Désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Déclaration des variables
    Dim c As Collection, i As Integer, Cel As Range

    'Déclare une nouvelle collection
    Set c = New Collection

    'Récupère le n° de ligne de tous les items filtrés
    For Each Cel In Range("B14:B" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        c.Add Cel.Row, CStr(Cel.Row)
    Next

    'Enlève le(s) filtres(s)
    Range("B13").Select
    On Error Resume Next
    ActiveSheet.ShowAllData

    'Pour chaque item de la collection - Bouclage décroissant
    For i = c.Count To 1 Step -1
        Range("B" & c(i) & ":D" & c(i)).Delete Shift:=xlUp
    Next

    'Vide la collection - Cela vide la mémoire
    Set c = Nothing

    'Active les messages d'alertes d'excel
    Application.DisplayAlerts = True

Bonne journée,

Baboutz

Merci Baboutz.

Du coup j'ai adapté sur un autre fichier modifié et final c'est fois-ci et cela fonctionne.

A bientôt