Microsoft 365 Macro modification que je ne sais pas faire

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une beau dimanche

Voici ci-dessous un code que j'ai besoin de modifier mais je n'y arrive pas malgré mes tentatives et recherches.
Pourriez-vous m'aider ?

Sub Lgn_vides()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.Unprotect Password:=""
    Sheets("RdV_faits").Select
        ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
        'Rows("107:10015").Select '???
        Selection.Delete Shift:=xlUp
        'Columns("R:ZZ").Select '???' R à dernière col vide
        Selection.Delete Shift:=xlToLeft
    Range("A1").Select
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

L'objectif est de supprimer les lignes et colonnes vides
Codes que je cherche à modifier :
Supprime toutes les lignes à partir de la 1ère cellule A (cellule active) vide
1er..... Code que je cherche à modifier : "'Rows("107:10015").Select '???" par de la 1ère ligne active à la dernière ligne vide,
Supprime toutes les colonnes à partir de la col "R" jusqu'à la dernière colonne vide
2eme Code que je cherche à modifier : "'Columns("R:ZZ").Select '???' R à dernière col vide

Si vous voulez bien juste modifier mes codes ci-dessus, ça, je pourrai le comprendre
Si besoin, je ferai un fichier test.
Un grand Merci ... je continue mes recherches,
Amicalement,
lionel

 

[Usine à gaz]

Bonjour Marcel
"Et si tu mets ça en premier, ça ne va pas un peu moins lentement ?"
J'ai tenté aussi ça et dans tous les sens lol
Pour les colonnes, c'est instantané. C'est bien ce code de suppression de lignes qui est long :

derniereLigne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = derniereLigne To 2 Step -1 ou     For r = derniereLigne To 6 Step -1
    If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r

"As-tu essayé de réduire la plage de CountA ?"
NON mais je ne sais pas le faire Grrrr !!!

 

[TooFatBoy]

Tu as beaucoup de colonnes après ZZ ?

"As-tu essayé de réduire la plage de CountA ?"
NON mais je ne sais pas le faire Grrrr !!!

Ben au lieu de Rows(r) essaye un Range pour limiter le nombre de colonnes.

 

[Usine à gaz]

"Tu as beaucoup de colonnes après ZZ ?"
C'est pas les colonnes le souci : la suppression des colonnes est instantanée.
Le souci, c'est les lignes et c'est bien ce code de suppression de lignes qui est TRES TRES TRES long :

derniereLigne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = derniereLigne To 2 Step -1 ou     For r = derniereLigne To 6 Step -1
    If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r

 

[TooFatBoy]

Une petite dernière tentative...

Tu as beaucoup de colonnes après ZZ ?

 

[Usine à gaz]

"Tu as beaucoup de colonnes après ZZ ?"
Merci Marcel pour tes tentatives mais je ne comprends pas pourquoi tu me poses cette question car même si je n'ai pas de colonne à supprimer, j'ai toujours le souci du code suppression des lignes qui est toujours TRES TRES TRES long.

 

[TooFatBoy]

Pas grave.

Bonne chance dans ta recherche de solution.

 

[Usine à gaz]

Pas compris mais merci quand même

 

[sylvanu]

Bonjour tout le monde,
Alors un essai d'après ce que j'ai compris de toutes ces errances :

Sub SuppressionLignesVides()
    Application.ScreenUpdating = False
    DerniereLigne = Range("A65000").End(xlUp).Row
    ' On repère la première ligne vide
    For L1 = 1 To DerniereLigne
        If Cells(L1, "A") = "" Then
            PremièreLigneVide = L1
            Exit For
        End If
    Next L1
    ' On repère la dernière ligne vide
    For L2 = L1 To DerniereLigne
        If Cells(L2, "A") <> "" Then
            DernièreLigneVide = L2 - 1
            Exit For
        End If
    Next L2
    ' On supprime
    Rows(PremièreLigneVide & ":" & DernièreLigneVide).Delete Shift:=xlUp
End Sub

Il n'y a qu'une suppression de lignes.

Si c'est pas ça, faites une petite image comme ci dessus, ça aidera.

 

[TooFatBoy]

Alors un essai d'après ce que j'ai compris de toutes ces errances

D'après ce que j'ai compris, il y a des lignes vides n'importe où dans le tableau, donc pas forcément consécutives, et il faut toutes les supprimer.

 

[sylvanu]

Oh! On va finir par converger !

 

[Usine à gaz]

Bonjour courageux sylvanu
Waooooh : c'est presque nickel
Juste il faudrait que la suppression commence après :
ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
C'est à dire après la dernière ligne NON VIDE de la feuille.
C'est presque tout bon !
C'est la solution du #post 37 avec une petite modif qui serait le mieux
Bravo

 

[TooFatBoy]

@sylvanu : pardon, mais est-ce que ça ne risque pas de supprimer des lignes dont la première colonne est vide, mais qui ne sont pas totalement vides (par exemple deuxième colonne non vide) ?

 

[Usine à gaz]

@sylvanu : pardon, mais est-ce que ça ne risque pas de supprimer des lignes dont la première colonne est vide, mais qui ne sont pas totalement vides (par exemple deuxième colonne non vide) ?

Bonne remarque lol Hé si
voire mon #post 41

 

[TooFatBoy]

Bonne remarque lol Hé si
voire mon #post 41

OK, mais ça n'a rien à voir avec ce que tu dis en #41.

 

[sylvanu]

Alors un mix avec ma méthode de suppression ( 1 seule suppression ) et le repère de lignes de votre code :

Sub SupLig()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    ' On créé une colonne en premiere colonne
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ' Dans cette colonne on met 1 si la ligne est vide ( reprise code Lionel )
    derniereLigne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = derniereLigne To 2 Step -1
        If Application.CountA(Rows(r)) = 0 Then
            Cells(r, "A") = 1
        End If
    Next r
    ' On tri cette colonne en valeurs décroissantes, donc les lignes vides au début
    Columns("A:B").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & DL) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil5").Sort
        .SetRange Range("A1:B" & DL)
        .Header = xlYes
        .Apply
    End With
    ' On repère le dernier 1 de la colonne A
    DL = Range("A65500").End(xlUp).Row
    ' On supprime les lignes
    Rows("2:" & DL).Delete Shift:=xlUp
    ' On supprime la colonne A créée précédemment
    Columns("A:A").Delete Shift:=xlToLeft
    [A1].Select
End Sub