VBA : Suppirmer les lignes sans valeur

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

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

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

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