effacer lignes "vides"Résolu

Question

bonjour,

voici mon problème.
Je travaille sur plusieurs classeurs dont 1 que j'apellerais saisie et les autres archive1, 2, 3....
le problème est que je copie aussi des lignes vides ou égale à zero.
J'utilise le code suivant : 

workbooks(typ).worksheets(nma).activate
    Dim DerniereLigne As Long 
    Dim i             As Long 
DerniereLigne = ActiveSheet.UsedRange.Row - 1 
DerniereLigne = DerniereLigne + ActiveSheet.UsedRange.Rows.Count 
For i = DerniereLigne To 1 Step -1 
    If Application.WorkSheetFunction.CountA(Rows(i)) = 0 Then _ 
        Rows(i).Delete 
Next i 

Mais à chaque fois, il efface les lignes vides sur le classeur saisie et pas sur le classeur d'archive.
Avez-vous une solution ?

D'avance merci.
Pascal

dedenet2 · Accepted Answer

Salut ,
J'ai eu ton classeur mais pourrais tu m'envoyer au moins 1 fichier typ
(par exemple EFG.xls) pour que je rende compte de son formatage.
Je pourrais tester le programme dans les conditions réels.
Bonne Vacances

dedenet2 · Answer

Bonjour koolman61

j'ai survolé rapidement ton programme car je n'ai pas le temps maintenant.

Pour supprimer les lignes sur les autres feuilles , il faut utiliser dans ton code
le nom de la feuille.
Apparemment , les lignes supprimees ne se font que sur la feuille active !

Peux tu me préciser ce que tu veux faire ?
J'essayerai de t'aider ce soir si ca va 
A++

koolman61 · Answer

pour une meilleure compréhension, je mets mon code en entier, tout fonctionne bien, sauf la partie en orange.
Il s'agit en fait de la gestion des interventions effectuées sur un parc de machines, chaque type de machines appartenant à un classeur qui lui même comprend plusieurs numero de machines.  A chaque machine correspont une feuille.

Private Sub CommandButton1_Click()



'def des variables

Dim k As String
Dim nma As String
Dim typ As String
Dim pat As String
Dim tip As String

'Rend le presse-papier disponible et vide
Application.CutCopyMode = False 
    
'choix du classeur machines


tip = Range("d8") 'type de machine sur la feuille de saisie



If tip "ERE" Or tip "BT" Then
        typ = ("ere.xls")    ElseIf tip "KMS" Or tip "EKS" Then
        typ = ("KMSEKS.xls")    ElseIf tip "ECE" Or tip "ECP" Then
        typ = ("ECPECE.xls")
    ElseIf tip = "EFG" Then
        typ = ("EFG.xls")
    ElseIf tip = "ETV" Then
        typ = ("ETV.xls")    ElseIf tip "ETX" Or tip "EKX" Then
        typ = ("ETXEKX.xls")    ElseIf tip "FOUR" Or tip "AUTRE" Or tip = "BANDE(anc)" Or tip = "BANDE(nou)" Then
        typ = ("DIVERS.xls")
End If


    'gestion exceptions
    nma = Range("b6").Value
    If tip = "BT" Then
    nma = tip & Range("b6").Value
    ElseIf typ = "DIVERS.xls" Then
    nma = tip
End If
    
    'recherche du classeur machines 
         pat = "C:\Documents and Settings\Pascal \Bureau\fiche de travail\archives"
            
    'trouve le bon classeur
        Workbooks.Open (pat & typ)
        
    'trouver dernière ligne vide
        k = Sheets(nma).UsedRange.SpecialCells(xlLastCell).End(xlToLeft).Row + 1
        
    'copier/coller les cellules
        Workbooks("feuille de travailv2.xls").Worksheets("Feuille de travail").Range("L2:X10").Copy
        Workbooks(typ).Worksheets(nma).Range("A" & k).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=True, Transpose:=False
        Workbooks(typ).Worksheets(nma).Range("a" & k).PasteSpecial Paste:=xlPasteFormats, operation:=xlNone, skipblanks:=True, Transpose:=False
    
    'effacement lignes vides
        Workbooks(typ).Worksheets(nma).Activate
        Dim DerniereLigne As Long
        Dim i             As Long
    DerniereLigne = ActiveSheet.UsedRange.Row - 1
    DerniereLigne = DerniereLigne + ActiveSheet.UsedRange.Rows.Count
        For i = DerniereLigne To 9 Step -1
    If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
        Next i


    'sauvegarde
        Workbooks(typ).Save
        
    'fermeture du classeur
        Workbooks(typ).Close
End Sub

dedenet2 · Answer

Bonsoir, Je me suis penché sur ton programme et j'ai fais une simulation en créant les même noms de fichiers ,les même noms de feuilles et de chemin d'accès. Si j'ai compris , le code copie la plage de saisie L2:X10 du classeur"feuille de travailv2" pour le coller ou rajouter dans le classeur (typ) a la suite des autres données et d'effacer les lignes vides de cette plage de saisie. Pour moi , ça semble fonctionner correctement sur Excel 2000. Donc, Ton programme efface bien les lignes vides sur le classeur archive [ "typ" dans le code] et il ne passe rien sur le classeur de saisie ["feuille de travailv2"]. Cela doit fonctionner comme ceci si j'ai bien compris ! Pour moi ,si ton programme efface les lignes sur le classeur saisie c'est parce que ce classeur est actif. C'est le classeur (typ) qui devrait être actif. Verifie par la methode "pas-à-pas" quelle est la feuille active au moment où le code efface les lignes ! Est ce que << Workbooks(typ).Worksheets(nma).Activate >> marche ! Essai éventuellement de remplacer ce code: DerniereLigne = ActiveSheet.UsedRange.Row - 1 DerniereLigne = DerniereLigne + ActiveSheet.UsedRange.Rows.Count Par DerniereLigne = Workbooks(typ).Worksheets(nma).UsedRange.Row - 1 DerniereLigne = DerniereLigne + Workbooks(typ).Worksheets(nma)..UsedRange.Rows.Count Je ne vois rien d'autres pour le moment ! De plus , je te conseille de rajouter un moyen de verifer le "filename" [pat & typ] de Open pour savoir si le chemin d'accès existe [ methode FileExists ] et aussi de vérifier que workbooks(typ) n'est pas déja ouvert avant de l'ouvrir. Dans les 2 cas , cela provoque des erreurs. Donne de tes nouvelles A++

koolman61 · Answer

bonjour,

tu as bien compris la procédure.

effectivement le classeur de saisie reste actif,  et le "Workbooks(typ).Worksheets(nma).Activate " ne sert effectivement à rien mais je l'ai laissé pendant mes test comme il ne me met pas d'erreur. Ceci dit je ne sais pas comment inactiver la feuille de saisie sans la fermer (ce qui pose problème car la macro est sur la feuille de saisie)
En ce qui concerne la vérification du classeur ouvert, elle n'est pas utile car à part moi avec la structure interne au boulot, personne n'a d'acces au dossier. Le seul accès peut se faire par la macro et je fais se fermer le classeur en fin de code (sauf erreur dans la macro).

Pour ce qui est de ton petit changement, j'y avais songé, mais j'arrivais pas à le transcrire (en voyant, c'est évident), ceci dit ça fonctionne toujours pas.

penses-tu qu'on ne pourrait forcer avec un with ?

genre : 
DerniereLigne = Workbooks(typ).Worksheets(nma).UsedRange.Row - 1
DerniereLigne = DerniereLigne + Workbooks(typ).Worksheets(nma). UsedRange.Rows.Count
with DerniereLigne
For i = DerniereLigne To 9 Step -1
    If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
        Next i
end with 

Mais je connais pas bien le with donc j'attends les suggestions.

merci

dedenet2 · Answer

Bonjour ,
Réponse matinale !

Avec Excel , du moment où un classeur est ouvert , il y aura forcement une feuille active.Ce qui veut dire que pour désactiver par exemple la feuil1  ,il faut activer une autre feuille [feuil2 par exemple].
Instruction With ne force rien. 
Par exemple avec ce code:
   Workbooks(typ).Worksheets(nma).Activate
   DerniereLigne = Workbooks(typ).Worksheets(nma).UsedRange.Row - 1
   DerniereLigne = DerniereLigne + Workbooks(typ).Worksheets
                           (nma).UsedRange.Rows.Count
      
Avec With , on obtiendrait maintenant       
         With Workbooks(typ).Worksheets(nma)
                  .Activate
                  DerniereLigne = .UsedRange.Row - 1
                  DerniereLigne = DerniereLigne + .UsedRange.Rows.Count
         End With

Ces 2 codes fonctionnement identiquement
Donc "With" permet de simplifier les écritures.Ca me force rien !

Concernant ton code qui me marche pas:

Qu'une feuille soit active ou pas , et du moment que le classeur est ouvert,
si tu precises dans ton code le nom du classeur et le nom de la feuille.
Ca doit marcher correctement.
Maintenant ,il se peut mais j'en doute que certaines instructions ne fonctionnent
pas sur les nouvelles versions d'Excel.
Je ne connais pas ta version d'Excel. Moi , j'ai Excel 2000.
Si ca me marche toujours pas chez toi ,il faut trouver un autre code equivalent.
Je peux peut être d'aider mais pour cela il faudrait que tu m'envoies la feuille
de saisie pour ma compréhension et pour savoir comment les saisies sont fait
(Fait une copie Ecran ,Enregistre sous un fichier photo et dans le message,utilise
 inserer une image).

 

A+++

koolman61 · Answer

merci pour tes réponses,  je pars en vacances demain debut d'après midi.

j'essaierais de répondre à ta demande demain matin, mais ne serait-il pas plus simple que je t'envoie le classeur de saisie en mp ?

koolman61 · Answer

oups j'oubliais, j'ai excel 2002

dedenet2 · Answer

ok , envoie le classeur
Que veux tu dire par mp ?
L'idéal , c'est le classeur d'origine en xls.
(je ne sais pas comment on peut envoyer un fichier depuis ce forum )

Bonne nuit

koolman61 · Answer

bonjour,

Voilà, le claseur de saisie est ici : 

http://www.vbfrance.com/codes/GESTION-INTERVENTIONS-SUR-PARC-MACHINES_47623.aspx

FaroukVazaha · Answer

Bonjour
Proposition de modification, lorsque tu travailles sur plusieurs pages ou plusieurs classeurs, tu dois toujours spécifier de façon explicite à quel endroit tu veux travailler : soit par un "activate" soit en nommant précisément la feuille ou le classeur.

Bon courage
 

Public FeuilleAEffacer 

Private Sub CommandButton1_Click()

'def des variables
Dim k As String
Dim nma As String
Dim typ As String
Dim pat As String
Dim tip As String

Application.CutCopyMode = False 'Rend le presse-papier disponible et vide
    
'choix du classeur machines le 21/07/08 par Pascal

tip = Range("d8") 'type de machine sur la feuille de saisie
If tip "ERE" Or tip "BT" Then
        typ = ("ere.xls")    ElseIf tip "KMS" Or tip "EKS" Then
        typ = ("KMSEKS.xls")    ElseIf tip "ECE" Or tip "ECP" Then
        typ = ("ECPECE.xls")
    ElseIf tip = "EFG" Then
        typ = ("EFG.xls")
    ElseIf tip = "ETV" Then
        typ = ("ETV.xls")    ElseIf tip "ETX" Or tip "EKX" Then
        typ = ("ETXEKX.xls")    ElseIf tip "FOUR" Or tip "AUTRE" Or tip = "ANC.BANDE" Or tip = "NOU.BANDE" Then
        typ = ("DIVERS.xls")
End If

    'gestion exceptions
    nma = Range("b6").Value
    If tip = "BT" Then
    nma = tip & Range("b6").Value
    ElseIf typ = "DIVERS.xls" Then
    nma = tip
End If
    
    'recherche du classeur machines le 14/07/08
        pat = "C:\Documents and Settings\Pascal Leroi\Bureau\fiche de travail\archives"
            
    'trouve le bon classeur
        Workbooks.Open (pat & typ)
        
    'trouver dernière ligne vide
        k = Sheets(nma).UsedRange.SpecialCells(xlLastCell).End(xlToLeft).Row + 1
        
    'copier/coller les cellules
        Set FeuilleAEffacer = Workbooks(typ).Worksheets(nma)
        Workbooks("feuille de travailv2.xls").Worksheets("Feuille de travail").Range("L2:X10").Copy
'        Workbooks(typ).Worksheets(nma).Range("A" & k).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=True, Transpose:=False
'        Workbooks(typ).Worksheets(nma).Range("a" & k).PasteSpecial Paste:=xlPasteFormats, operation:=xlNone, skipblanks:=True, Transpose:=False
        
        FeuilleAEffacer.Range("A" & k).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=True, Transpose:=False
        FeuilleAEffacer.Range("a" & k).PasteSpecial Paste:=xlPasteFormats, operation:=xlNone, skipblanks:=True, Transpose:=False '(Pourquoi en double ??)
        
        
    'effacement lignes vides
'        Workbooks(typ).Activate
        Dim DerniereLigne As Long
        Dim i             As Long
'    DerniereLigne = Workbooks(typ).Worksheets(nma).UsedRange.Row - 1
'    DerniereLigne = DerniereLigne + Workbooks(typ).Worksheets(nma).UsedRange.Rows.Count
'        For i = DerniereLigne To 9 Step -1
'    If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
'        Next i

    DerniereLigne = FeuilleAEffacer.UsedRange.Row - 1
    DerniereLigne = DerniereLigne + FeuilleAEffacer.UsedRange.Rows.Count
        For i = DerniereLigne To 9 Step -1
    If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then FeuilleAEffacer.Rows(i).Delete
        Next i

    'sauvegarde
        Workbooks(typ).Save
        
    'fermeture du classeur
        Workbooks(typ).Close
        
    'réactivation feuille de saisie
        Workbooks("feuille de travailv2.xls").Activate

End Sub

Effacer lignes "vides"

11 réponses

Votre réponse

Discussions similaires