Supprimer lignes non renseignées

Bonsoir,

J'ai une feuille COLLABT qui me fait la synthèse de 8 autres feuilles (COLLAB1 à 8)

Ces feuilles sont mises à jour depuis des classeurs externes (C1 à C8), via la formule :

=[C1.xlsx]COLLAB!$A:$O pour la feuille COLLAB1, et ainsi de suite

Mon problème vient du fait que le tableau en COLLAB1 ne se met pas automatiquement à jour au niveau du nombre total de ligne si je ne l'ai pas "tiré", pour copier les formules qu'il contient.

Je peux éviter le problème en "tirant" à l'avance suffisamment de lignes, mais le traitement de COLLABT montre alors également les lignes qui n'ont pas été renseignées. Ce qui peut très vite devenir problématique (par exemple si je tire à l'avance 50 ou 100 lignes pour chaque feuille).

Voici le code de la macro qui fait la synthèse en COLLABT:

Option Explicit

Public sh As Worksheet, Ws As Worksheet
Public plage As Range, cel As Range, derlig As Long

Sub COLLABT()

    Application.ScreenUpdating = False

    Set Ws = Sheets("COLLABT")
    Ws.Range("a2:o80000").ClearContents

    For Each sh In Sheets
        Select Case sh.Name
        Case "COLLAB1", "COLLAB2", "COLLAB3", "COLLAB4", "COLLAB5", "COLLAB6", "COLLAB7", "COLLAB8"
            derlig = sh.Range("a" & Rows.Count).End(xlUp).Row
            Set plage = sh.Range("a2:o" & derlig)
            plage.Copy
            Set cel = Ws.Range("a65536").End(xlUp)(2)
            cel.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = 0
            Application.Goto Ws.Range("a1")
        End Select
    Next sh
End Sub

J'ai tenté d'ajouter ce code pour résoudre le problème sans succès :

Sub DeleteRows(mySheet As Worksheet)
Dim ws As Excel.Worksheet
Dim LastRow As Long

Set ws = mySheet
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
With ws.Range("A2:A" & LastRow)
    If WorksheetFunction.CountBlank(.Cells) > 0 Then
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
End With
End Sub

Je ne suis pas très bon en programmation. Si quelqu'un pouvait m'indiquer la solution, voir corriger le code en conséquence, je lui en serais très reconnaissant.

J'ai aussi joint le classeur principal et l'un des classeurs externes pour mieux faire comprendre le problème.

Merci d'avance.

Bonjour Ebusmaximus le forum

tu considères tes lignes vide à quelles conditions?

que la ligne soit complètement vide? que la colonne Job soit vide ? ou bien ??

merci de donner tes conditions de suppression et je te fais cela par retour

a+

Papou

Bonjour à tous

Un essai pour supprimer les lignes vides. A intégrer dans ta macro principale.

Bye !

 Sub ess()

    tablo = Range("A2:O" & Range("A" & Rows.Count).End(xlUp).Row)
    k = 1
    For i = 1 To UBound(tablo, 1)
        nb = 0
        For j = 1 To UBound(tablo, 2)
            If tablo(i, j) = "" Then
                nb = nb + 1
            End If
        Next j
        If nb < UBound(tablo, 2) Then
            ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To k + 1)
            For j = 1 To UBound(tablo, 2)
                tabloR(j, k) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i
    Range("A2:O" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    Range("A2").Resize(UBound(tabloR, 2), UBound(tabloR, 1)) = Application.Transpose(tabloR)
 End Sub

paritec a écrit :

Bonjour Ebusmaximus le forum

tu considères tes lignes vide à quelles conditions?

que la ligne soit complètement vide? que la colonne Job soit vide ? ou bien ??

merci de donner tes conditions de suppression et je te fais cela par retour

a+

Papou

Bonjour paritec.

Je considère une ligne vide si la première colonne n'a pas été renseignée (Collab).

Merci.

gmb a écrit :

Bonjour à tous

Un essai pour supprimer les lignes vides. A intégrer dans ta macro principale.

Bye !

 Sub ess()

    tablo = Range("A2:O" & Range("A" & Rows.Count).End(xlUp).Row)
    k = 1
    For i = 1 To UBound(tablo, 1)
        nb = 0
        For j = 1 To UBound(tablo, 2)
            If tablo(i, j) = "" Then
                nb = nb + 1
            End If
        Next j
        If nb < UBound(tablo, 2) Then
            ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To k + 1)
            For j = 1 To UBound(tablo, 2)
                tabloR(j, k) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i
    Range("A2:O" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    Range("A2").Resize(UBound(tabloR, 2), UBound(tabloR, 1)) = Application.Transpose(tabloR)
 End Sub

Bonjour,

Merci pour la réponse mais ça n'a rien changé. J'ai toujours les lignes vides après exécution de la macro.

Je pense que cela vient du fait que les lignes ne sont pas "techniquement" vides, mais contiennent une formule.

Bonjour Ebusmaximus

ton fichier en retour avec ce que tu veux

tu ouvres tu cliques mise à jour

a+

Papou

Un essai à tester.

Bye !

Bonjour, vos 2 modifications fonctionnent parfaitement.

Un énorme merci à vous 2.