Rajouté un morceau de code à la fin.

awa123

XLDnaute Occasionnel
Bonjour,
j'ai un fichier 'donnees' qui renvoi des données triés au fichier 'program'
maintenant j'aimerais rajouter cette ligne de code au fichier 'donnees' pour lui dire que une fois qu'il a renvoyés toutes les données triés au fichier 'program' il supprime les lignes sur lesquels la cellule de la colonne A est vide (du fichier program);

la ligne de code à rajouter sera donc :

Code:
Cells.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

mais quel variables utilisées?

j'ai essayé ceci :
Code:
Sub supprimer()
With Workbooks("program").Worksheets("Data")
Cells.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
End With
End Sub

mais ça ne fonctionne pas.
comment y remédier??
PS: je met en pièce jointe les fichier 'donnees' et 'program' en question.
 

Pièces jointes

  • donnees.zip
    18.1 KB · Affichages: 23
  • program.zip
    20.2 KB · Affichages: 25
  • donnees.zip
    18.1 KB · Affichages: 30
  • program.zip
    20.2 KB · Affichages: 23
  • donnees.zip
    18.1 KB · Affichages: 24
  • program.zip
    20.2 KB · Affichages: 22

youky(BJ)

XLDnaute Barbatruc
Re : Rajouté un morceau de code à la fin.

Bonjour awa,
J'ai pas ouvert les fichers mais je peux te dire qu'avec un With ....
il faut ensuite mettre un point avant le Cell et le Range
.Cells.Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Speci

si on oubli le point c'est la page active qui est prise en compte

Bruno
 

youky(BJ)

XLDnaute Barbatruc
Re : Rajouté un morceau de code à la fin.

Voici la correction....il faut gérer l'error si pas de blanc.
Bruno
Code:
Sub supprimer()
Set W = Workbooks("program.xlsm").Sheets("Data")
On Error Resume Next
 W.Cells.Range("A3:A" & W.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 Err.Clear
 End Sub
 

awa123

XLDnaute Occasionnel
Re : Rajouté un morceau de code à la fin.

pouvez vous le tester svp en le mettant à la fin du code du fichier 'donnees' (attention il faut activer Microsoft Scripting Runtime en allant dans outil ==> reference et cocher la case en question).
ainsi lors de l'execution de la macro. du fichier 'donnees' il faudra rechercher le chemin du classeur 'program'.

comme ça vous pourrez me dire exactement comment rémedier .... car je suis toujours sans résultat malgrè les manip.
merci
 

youky(BJ)

XLDnaute Barbatruc
Re : Rajouté un morceau de code à la fin.

Bon je pense être sur le bon chemin.
Je sauve le fichier progam avant de le fermer
Si tu veux pas enleve.... Wbk.Save
Bruno
Code:
Sub Traiter()
Dim Wbk As Workbook
Dim Fichier
 
Fichier = Application.GetOpenFilename("Excel Files (*.xlsm*), *.xlsm*")
If Fichier <> False Then
    Set Wbk = Workbooks.Open(Fichier)
    Recap Wbk.Worksheets(2).Range("A3")
   With Sheets("Data")
 On Error Resume Next
 .Cells.Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 Err.Clear
   End With
   Wbk.Save
    Wbk.Close True
    Set Wbk = Nothing
End If
MsgBox "Traitement terminé..."
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : Rajouté un morceau de code à la fin.

Bonsoir à tous

pouvez vous le tester svp en le mettant à la fin du code du fichier 'donnees' (attention il faut activer Microsoft Scripting Runtime en allant dans outil ==> reference et cocher la case en question).

Sauf erreur de ma part, je ne vois rien ici qui ressemble à du VBS.
Donc pourquoi activer cette référence?
 

awa123

XLDnaute Occasionnel
Re : Rajouté un morceau de code à la fin.

Bnjour Staple1600 , dsl

lorsqu'on active pas Microsoft Scripting Runtime avant l'execution du VBA ,cela ne fonctionne pas.

en activant Microsoft Scripting Runtime cela nous permet automatiquement de chercher le chemin du fichier dans lequel nous voulons envoyer les données.

J'avais demander si quelqu'un pouvez tester le code en y ajoutant le petit code consistant à supprimer les lignes car cela ne fonctionnait pas chez moi.

cordialement

youky(BJ) svp pouvez vous tester ces deux fichiers en pièce jointe,
lorsqu'on lance l'execution , on remarque qu'il y a toujours des cases vides entre les données dans le fichier 'program' (dans la feuille 'data')
 

Pièces jointes

  • donnees.zip
    19.4 KB · Affichages: 21
  • program.zip
    20.1 KB · Affichages: 24
  • donnees.zip
    19.4 KB · Affichages: 24
  • program.zip
    20.1 KB · Affichages: 22
  • donnees.zip
    19.4 KB · Affichages: 22
  • program.zip
    20.1 KB · Affichages: 25
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Re : Rajouté un morceau de code à la fin.

Voici une nouvell version
Je pense que cela était dut au tableau automatique
Alors j'ai fait une boucle
Bruno
Code:
Sub Traiter()
Dim Wbk As Workbook
Dim Fichier
Dim lig As Long
Fichier = Application.GetOpenFilename("Excel Files (*.xlsm*), *.xlsm*")
If Fichier <> False Then
    Set Wbk = Workbooks.Open(Fichier)
    Recap Wbk.Worksheets(2).Range("A3")
    Wbk.Activate
    With Sheets("Data")
 For lig = .Range("A" & Rows.Count).End(3).Row To 3 Step -1
 If .Cells(lig, 1) = "" Then .Rows(lig).Delete
 Next
   End With
   Wbk.Save
   Application.ScreenUpdating = True
    MsgBox "Traitement terminé..."
    Wbk.Close True
    Set Wbk = Nothing
End If
End Sub

PS Pour la réf à cocher c'est le New Scripting.Dictionary qui en a besoin
 

Discussions similaires

Réponses
6
Affichages
191

Statistiques des forums

Discussions
312 922
Messages
2 093 658
Membres
105 777
dernier inscrit
Lili1411