VBA : Suppirmer les lignes sans valeur

Fermé
NeedHelp - Modifié par jordane45 le 6/05/2015 à 13:44
 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.
.

4 réponses

jordane45 Messages postés 38145 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 25 avril 2024 4 650
Modifié par jordane45 le 6/05/2015 à 13:48
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
0
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
0
ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 2 404
6 mai 2015 à 16:23
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
0
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.
0
ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 2 404
Modifié par ccm81 le 6/05/2015 à 16:43
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 ...
0
NeedHelp > ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024
Modifié par NeedHelp le 6/05/2015 à 17:02
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
0
ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 2 404
6 mai 2015 à 17:47
Désolé, il te faut aussi y ajouter la référence au classeur CD
exemple
https://www.cjoint.com/?3EgsaXgp1zA
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 6/05/2015 à 16:31
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
0
ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 2 404
Modifié par ccm81 le 6/05/2015 à 16:38
Ouaouhhh, je note dans mes tablettes
je plussoierai plus tard au cas où le demandeur commencerait
sa lecture par la fin ;-)

Cordiales salutations
0
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
0