VBA : Suppirmer les lignes sans valeur

NeedHelp -
NeedHelp - 6 mai 2015 à 18:09

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

Afficher la suite

A voir également:

VBA : Suppirmer les lignes sans valeur
Excel compter cellule couleur sans vba - Guide
Incompatibilité de type vba ✓ - Forum VB / VBA
Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
Mkdir vba ✓ - Forum VB / VBA
Dépassement de capacité vba ✓ - Forum Excel

4 réponses

Réponse 1 / 4

jordane45 Messages postés 38486 Date d'inscription Statut Modérateur Dernière intervention 4 752

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

NeedHelp

Bonjour Jordane,

Merci pour ton aide. Mes tableaux varient, mon fichier source ne sera jamais identique. J'ai des lignes vides qui vont s'intercaler entre des lignes avec des valeurs.

Ex : valeur de A1 à A10, puis rien de A11 à A13, etc...

Y'a t-il un moyen de supprimer ces lignes à l'aide d'un code? Merci

Réponse 2 / 4

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

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

NeedHelp

Bonjour ccm81, comme tu l'auras compris je suis novice en VBA, a quel endroit dois-je inscrire ce code dans ma macro? Mon code est un peu plus haut. Merci beaucoup pour ton aide précieuse.

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

tu prends le code de Michel (plus simple ci-dessous) et tu le colles après la copie
OS.Range("A1:A10000").Copy OD.Range("A1")

n'oublies pas d'y ajouter la référence à la feuille OD
OD.Columns("A")......
etc ...

NeedHelp > ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention

C'est ce que j'ai fais, on m'indique une erreur dans cette ligne :

OD.Range("A1:A" & derlig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

"erreur d'execution 1004" Pas de cellules correspondantes.

Merci pour votre aide ccm81 et MIchel

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

Désolé, il te faut aussi y ajouter la référence au classeur CD
exemple
https://www.cjoint.com/?3EgsaXgp1zA

Réponse 3 / 4

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour,
salut CCM81 ;o)
une astuce pour supprimer les lignes vides sans boucle

Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
If Application.CountIf(Range("A1:A" & Derlig), "") > 0 Then
  Range("A1:A" & Derlig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If

--
Michel

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

Ouaouhhh, je note dans mes tablettes
je plussoierai plus tard au cas où le demandeur commencerait
sa lecture par la fin ;-)

Cordiales salutations

Réponse 4 / 4

NeedHelp

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

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Erreur d'exécution 13 Incompatibilité de type

appliquer une pause dans une macro vba excel

ouverture d'un fichier excel à partir d'un code VBA

Méthode find dans VBA - Recherche de données sous Excel

Votre réponse

Discussions similaires