VBA : Suppirmer les lignes sans valeur Fermé

Question

Bonjour a tous,

Grace a une macro, j'ai pu extraire les données que je souhaite et les coller dans un nouveau classeur. Or toutes les lignes sont copiées même les lignes vides, je souhaite supprimer les lignes vides dans mon nouveau classeur.
Pouvez-vous m'aider a trouver le code pour supprimer les lignes sans valeurs. Merci
Voici le code :

Sub Macro1()

Dim CS As Workbook
    Dim OS As Worksheet
    Dim CD As Workbook
    Dim OD As Worksheet
    Dim NU As Variant
    Dim BU As String

'Definition du fichier Source
    Set CS = ThisWorkbook
    Set OS = CS.Sheets("database CSV")

ici:
    'Demander les initiales de l'utilisateur'
    NU = Application.inputbox(" Vos initiales ? ", Type:=2)
    If NU = False Then Exit Sub

'Reprendre les initiales pour les insérer dans titre de sauvegarde'
    If NU = "" Then
    MsgBox "Vous ne vous êtes pas identifiez !"
    GoTo ici
    
    End If

'Définition du fichier Destinataire
    Set CD = Workbooks.Add
    Application.DisplayAlerts = False
    'CD.Sheets(Array("Feuil2", "Feuil3")).Delete
    Application.DisplayAlerts = True
    Set OD = CD.Sheets(1)
    OS.Range("A1:A10000").Copy OD.Range("A1")

'Renseigner la BU
    BU = CS.Worksheets("JT_CASH_ALLOCATION").Range("A3").Value

'Enregistrer sous avec format sauvegarde'
    
    ChDir "C:\Users\...\..."
    CD.SaveAs Filename:=BU & "_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "hhmm") & "_" & NU, FileFormat:=xlCSVMSDOS _
    , CreateBackup:=False

'Message de validation de sauvegarde'
    MsgBox "Le document a bien été enrégistré", vbOKOnly
    
    CD.Close False

End Sub

Merci beaucoup pour votre aide.

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code 

Merci d'y penser dans tes prochains messages.
.

jordane45 · Answer

Bonjour,

Tu as des lignes vides car je suppose que tes tableaux ne vont pas tous jusqu'à la ligne 10000 ...
Donc quand tu fais ceci :

OS.Range("A1:A10000").Copy OD.Range("A1")
 
tu prends.... "large" ...

Le mieux déjà, serait de ne copier que le nombre de ligne exacte de tes tableaux.
Pour cela.. tu peux chercher le numéro de la dernière ligne de tes tableaux et ajuster la plage en conséquence.

Par exemple avec un truc du genre :

Derniere_Ligne = OS.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
 OS.Range("A1:A" & Derniere_Ligne ).Copy OD.Range("A1")


ça devrait déjà réduire considérablement le nombre de lignes vides...



PS: Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code 
 
.
 
Cordialement, 
Jordane

ccm81 · Answer

Bonjour à tous

Pour supprimer les lignes dont la colonne A est vide

Option Explicit

Const coA = "A"
Const lideb = 2

Public Sub SuppLignesAvide()
Dim li As Long, lifin As Long
Application.ScreenUpdating = False
With ActiveSheet
  lifin = .Range(coA & Rows.Count).End(xlUp).Row
  For li = lifin To lideb Step -1
    If .Range(coA & li) = "" Then
       Rows(li).Delete
    End If
  Next li
End With
Application.ScreenUpdating = True
End Sub
Cdlmnt

michel_m · Answer

Bonjour,
salut CCM81 ;o)
une astuce pour supprimer les lignes vides sans boucle 
Derlig = Columns("A").Find("*", , , , , xlPrevious).RowIf Application.CountIf(Range("A1:A" & Derlig), "") > 0 Then  Range("A1:A" & Derlig).SpecialCells(xlCellTypeBlanks).EntireRow.DeleteEnd If --
 Michel

NeedHelp · Answer

Tu vas vraiment me prendre pour une bille, si ce n'est déjà le cas... mais ça ne fonctionne pas, qu'y a-t-il de faux dans mon code? Merci bcp

Voici mon code

Sub Macro1()

Dim CS As Workbook
    Dim OS As Worksheet
    Dim CD As Workbook
    Dim OD As Worksheet
    Dim NU As Variant
    Dim BU As String
    Dim derlig As Long

'Definition du fichier Source
    Set CS = ThisWorkbook
    Set OS = CS.Sheets("database CSV")

ici:
    'Demander les initiales de l'utilisateur'
    NU = Application.inputbox(" Vos initiales ? ", Type:=2)
    If NU = False Then Exit Sub

'Reprendre les initiales pour les insérer dans titre de sauvegarde'
    If NU = "" Then
    MsgBox "Vous ne vous êtes pas identifiez !"
    GoTo ici
    
    End If

'Définition du fichier Destinataire
    Set CD = Workbooks.Add
    Application.DisplayAlerts = False
    CD.Sheets(Array("Feuil2", "Feuil3")).Delete
    Application.DisplayAlerts = True
    Set OD = CD.Sheets(1)
    OS.Range("A1:A10000").Copy OD.Range("A1")
    
    'Supprimer les lignes vides
    With CD.Sheets(1)
    derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
    If Application.CountIf(.Range("A1:A" & derlig), "") > 0 Then
    .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
    End With

'Renseigner la BU
    BU = CS.Worksheets("JT_CASH_ALLOCATION").Range("A3").Value

'Enregistrer sous avec format sauvegarde'
    ChDir "C:\Users\...\..."
    CD.SaveAs Filename:=BU & "_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "hhmm") & "_" & NU, FileFormat:=xlCSVMSDOS _
    , CreateBackup:=False

'Message de validation de sauvegarde'
    MsgBox "Le document a bien été enrégistré", vbOKOnly
    
    CD.Close False

End Sub

Merci ccm81

VBA : Suppirmer les lignes sans valeur

4 réponses

Discussions similaires