macro - ne pas copier une ligne si une cellule est vide

AthessWinbug

XLDnaute Nouveau
Bonjour à tous,

Le fichier ci-joint Ce lien n'existe plus, est un système de pointage pour mes gars en atelier.

Ils s'identifient, rentrent la date de leur journée de travail, puis rentrent le ou les motifs et les heures, se trouvent donc deux lignes pour décrire leur journée.

A partir de là en sauvegardant, ça enregistre automatiquement les deux lignes.

problématique: si la personne ne rentre qu'un seul motif, ça copie tout de même la seconde ligne qui reste vierge, mon tableau au fil du temps pourrait ressembler à un gruyère.

Question: lors de la copie, pourrait-on dans la macro dire, si la case motif de la seconde ligne est vide alors celle-ci n'est pas copiée?
 

Paf

XLDnaute Barbatruc
Re : macro - ne pas copier une ligne si une cellule est vide

Bonjour,

A priori j'arrive un peu tard,mais puisque c'est fait: la macro en cause, modifiée et dépoussiérée notamment des sélections de 100000 lignes en tri et copie alors que 99900 sont vierges:

Code:
Sub copiefred()

Dim DerLig As Integer, Lig1Vide As Integer, Plage As String

    With Worksheets("pointage")
    If .Range("E11") = "" Then
        MsgBox "Aucun nom saisi !"
        .Range("E11").Select
        Exit Sub
    End If

    If .Range("C27").Value <> "" Then
        Lig1Vide = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & Lig1Vide & ":H" & Lig1Vide).Value = Range("A27:H27").Value
    End If
    If .Range("C28").Value <> "" Then
        Lig1Vide = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & Lig1Vide & ":H" & Lig1Vide).Value = Range("A28:H28").Value
    End If
    
    '** effacement de la zone de saisie
    .Range("E11:F11,E13:G13,F17:G17,I17:J17,L17:M17,O17,Q17:R17,T17,F18:G18,I18:J18,L18:M18,O18,Q18:R18,T18").ClearContents
    
    '** Recherche de la dernière ligne de données
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    
    '** determination de la plage de données à manipuler
    Plage = "A30:H" & DerLig
    
    '** tri de la plage de données
    .Range(Plage).Sort Key1:=.Range("B30"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    '** copie de la plage de données en feuille "relevé"
    .Range(Plage).Copy Sheets("relevé").Range("A2")
    
    .Range("E11").Select
    End With
    
    Sheets("INDEX").Activate
    Range("A1").Select
    ActiveWorkbook.Save
    
End Sub

Bonne suite
 

Discussions similaires

Statistiques des forums

Discussions
312 687
Messages
2 090 950
Membres
104 705
dernier inscrit
Mike72