Rajout Effacer des lignes vides dans une macro

[wishtolearn]

Hello à tous,

J'aurai besoin de vos lumières concernant VBA.

Je souhaiterais rajouter une ligne à cette macro afin de suprimer les lignes vides restantes mais sans pour autant effacer les lignes contenant du texte, car ça me permettrait de ne pas avoir à les supprimer manuelement, histoire que la feuille où est executée la macro em question ne ressemble à um gruyère avec des lignes vides intercallées avec des lignes remplies.

Um merci d'avance pour votre aidé.

Sub Others()
    Dim i As Variant
    Dim endrow As Integer
    Dim DAV As Worksheet, OTH As Worksheet

    Set DAV = ActiveWorkbook.Sheets("Demandes à valider")
    Set OTH = ActiveWorkbook.Sheets("Other & Special Requests")

    endrow = DAV.Range("A" & DAV.Rows.Count).End(xlUp).Row

    For i = 2 To endrow
        If DAV.Cells(i, "G").Value = "Others" And DAV.Cells(i, "I").Value = "To be Done" Then
           DAV.Cells(i, "G").EntireRow.Cut Destination:=OTH.Range("A" & OTH.Rows.Count).End(xlUp).Offset(1)
        End If
    Next
End Sub

 

[Arthur931]

Bonjour wishtolearn,

Tu fais une boucle pour déterminer tes lignes vides et une condition if (lorsque ta ligne est vide) avec cette formule pour supprimer la ligne :
Rows(i).EntireRow.Delete

Par exemple :
Sub Suplignvides()
Dim r As Long
For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(r)) = Empty Then Rows(r).EntireRow.Delete
Next r
End Sub

 

[wishtolearn]

Merci Arthur pour ta réponse. Je pense que je fais quelque chose de pas bien car j'obtiens un message d'erreur. Saurais-tu me dire ce que je ne fais pas bien? Merci beaucoup pour toute l'aide que tu pourras m'apporter.

Sub Others()
    Dim i As Variant
    Dim endrow As Integer
    Dim DAV As Worksheet, OTH As Worksheet

    Set DAV = ActiveWorkbook.Sheets("Demandes à valider")
    Set OTH = ActiveWorkbook.Sheets("Other")

    endrow = DAV.Range("A" & DAV.Rows.Count).End(xlUp).Row

    For i = 2 To endrow
        If DAV.Cells(i, "G").Value = "Others" And DAV.Cells(i, "K").Value = "To be Done" Then
           DAV.Cells(i, "G").EntireRow.Cut Destination:=OTH.Range("A" & OTH.Rows.Count).End(xlUp).Offset(1)
        End If

        Sub Suplignvides()
Dim r As Long
For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(r)) = Empty Then Rows(r).EntireRow.Delete
Next r
Next
        End Sub

 

[Arthur931]

Oui, tu commences un nouveau Sub sans avoir fermé l'autre.

Essaye en supprimant la ligne :
Sub Suplignvides()

Par ailleurs il manque le i à ton dernier Next pour éviter toute erreur d'interprétation ainsi qu'un End If. Tu devrais essayer de bien indenter ton code, ça te permettrait d'identifier ces manques assez rapidement.

Sub Others()
Dim i As Variant
Dim endrow As Integer
Dim DAV As Worksheet, OTH As Worksheet

Set DAV = ActiveWorkbook.Sheets("Demandes à valider")
Set OTH = ActiveWorkbook.Sheets("Other")

endrow = DAV.Range("A" & DAV.Rows.Count).End(xlUp).Row

For i = 2 To endrow
If DAV.Cells(i, "G").Value = "Others" And DAV.Cells(i, "K").Value = "To be Done" Then
DAV.Cells(i, "G").EntireRow.Cut Destination:=OTH.Range("A" & OTH.Rows.Count).End(xlUp).Offset(1)
End If


Dim r As Long
For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(r)) = Empty Then
Rows(r).EntireRow.Delete
End if
Next r

Next i
End Sub

 

[wishtolearn]

Un énorme merci. Tu es magique, ça fonctionne au poil. Merci encore et excellente journée

 

[wishtolearn]

Dernière question: est-ce possible de rajouter un .value quelque part afin que la fonction cut ne vienne détruire la MFC instaurée sur les lignes de destination?

Merci.