Rajout Effacer des lignes vides dans une macro

wishtolearn

XLDnaute Nouveau
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é.

VB:
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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.

VB:
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

XLDnaute Nouveau
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
 

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 049
Membres
101 882
dernier inscrit
XaK_