VBA Macro copie/colle valeur cellule non vide à la fermeture

[Anais51]

Bonsoir!

Je suis une grande débutante en VBA, et je cherche à faire une macro capable de copier coller les valeurs des cellules d'une plage précise (dans tout les onglets sauf deux mais dans un premier temps j'essaye de faire dans un onglet) à la fermeture du fichier avant de sauvegarder. Pour l'instant VBA pour moi c'est une partie de légo: je trouve des formules par ci par là et j'essaye d'assembler le tout pour en faire ce que je veux. Donc voici ce que j'ai tenté qui ne fonctionne pas:

Private Sub WorkBook_BeforeClose()
Dim Plage_Cible As Range


'Définit la plage qui doit réagir à l'évènement
Set Plage_Cible = Range("E9:K22")


'boucle sur chaque cellule de la plage à traiter( pasage obligé, le_
'"selectcase" ne peut travailler que sur une cellule à la fois)
For Each C In Plage_A_Traiter.Cells


'Action seulement sur cellule non-vide
If Not IsEmpty(C) Then
'Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues,
End If
Next C
ActiveWorkbook.Save
End Sub

Je reconnais que j'ai du mal à saisir les explications données dans d'ancien posts, il se peut que j'ai fait d'énorme erreur (surtout que mon niveau d'anglais est absolument abominable donc l'encodage en anglais m'aide pas vraiment)

Donc si vous avez quelques pistes à me donner je suis preneuse

 

[Guest]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Bonjour,

D'après le contenu de ta macro j'en ai conclu que tu cherchais à éliminer les formules tout en gardant les résultats. si c'est le cas:
(remplacer) Nom1 et Nom2 par le nom des feuilles à éviter.

Private Sub WorkBook_BeforeClose()
    Dim Plage_Cible As Range
    Dim sh As Worksheet
    For Each sh In Worksheets
       If sh.Name <> "Nom1" And sh.Name <> "Nom2" Then
            On Error Resume Next
            'Ne tient compte que les cellules ayant une formule
            Set Plage_Cible = Sh.Range("E9:K22").SpecialCells(xlCellTypeFormulas)
            'S'il y en a leur résultat sera conservé 
            If Not Plage_Cible Is Nothing Then Plage_Cible.Value = Plage_Cible.Value
            Set Plage_Cible = Nothing
        End If
    Next
    ActiveWorkbook.Save
End Sub

A+

 

[Gorfael]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Salut Anais51 et le forum
C'est pas si mauvais que tu crois : peu d'erreurs sur ta macro, mais sans explications de ce que tu veux réellement faire...

je cherche à faire une macro capable de copier coller les valeurs des cellules d'une plage précise (dans tout les onglets sauf deux mais dans un premier temps j'essaye de faire dans un onglet) à la fermeture du fichier avant de sauvegarder.

On a la plage d'arrivée, par ton code : E9:K22.

Mais la plage de départ, d'où doivent être copiées les valeurs ?

Si tu avais mis l'obligation de déclarer toutes tes variables, tu te serais rendu compte qu'une de tes variable n'est pas initialisée : Plage_A_Traiter !

En gros, tu copies les valeurs d'une plage de formule, dans une autre plage.

Je ne pense pas que la méthode for each soit le meilleur choix.

Private Sub WorkBook_BeforeClose()
Dim Plage_Cible As Range, Plage_A_Traiter as range, X as long
'Il vaut mieux tout déclarer

    'Définit la plage qui doit réagir à l'évènement 
    Set Plage_Cible = Range("E9:K22")
    'Set Plage_A_Traiter = <<ce doit être une plage de 14 lignes 7 colonnes>>

    'boucle sur chaque cellule de la plage à traiter
       For X=1 to Plage_A_Traiter.Cells.count
       'pour X=1 à nombre de cellule dans la plage de départ
               if Not IsEmpty(Plage_A_Traiter.Cells(x)) then
    'si la Xème cellule de la plage de népart n'est pas vide, alors
    'perso, je préfère <>""
        Plage_Cible.cells(X)=Plage_A_Traiter.Cells(x)
        'valeur Xème cellule plage cible= valeur Xème cellule plage à traiter
                 End If
       Next X
     ActiveWorkbook.Save
End Sub

Ce qui n'allait pas dans ta macro :
- Pas d'initialisation de ta plage de départ
- Pas d'attribution d'une cellule à l'arrivée
- Évite les select/selection : ça ne sert à rien d'autre qu'à ralentir la macro
- erreur de syntaxe :

Selection.PasteSpecial Paste:=xlPasteValues,

Tu finis par une virgule=> ça veut dire qu'il y a un autre argument qui suit, ce qui n'est pas le cas. La même sans la virgule finale fait le collage de la valeur.

Juste une remarque : tu ne copies que les valeurs non nulles. Ça me gène un peu (je ne connais pas le besoin réel). Un exemple pour illustrer mon malaise :
départ : A1, A2 Arrivée : X1,X2
A1=10, A2="" =>on sort
Réouverture : A1=10, A2=0, X1=10, X2=""
On modifie A1="", A2=20 => on sort
Réouverture : A1="", A2=20, X1=10, X2=20
Si j'ai eu 15 autres modifications de A2 et pas une seule nouvelle de A1, j'ai toujours X1=10

Mais comme je l'ai dit, je ne connais pas le problème réel.

Pour les feuilles, tu peux faire une boucle For Each, puisqu'on ne change pas de feuille pour copier les valeurs.
A+

 

[Anais51]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Bonjour à tous!

Tout d'abord merci pour vos réponses rapide.

Mon programme a pour vocation de faire un historique. En copiant collant une base de données dans un onglet certaines informations clés apparaissent dans des tableaux de différents onglets. Il y a des dates, et si la dates ne changent pas il n'y a pas de nouveaux résultats mais pour cela il faut que les modifications des changements s'enregistre en valeur et non en formules.

Hasco => Ta macro ne fonctionne pas, il est possible que ce soit du à ma version de 2003? il me semble que j'ai lut dans un aute topic que le lancement à la fermeture était une autre phrase de macro avant.

Goarfel => Mes cellules de destination sont les mêmes que celles du départ. En fait je veux que dans ma plage de données les formules ayant aboutit à un résultat se figent définitivement. Ne garder que les résultats mais les formules n'ayant pas encore aboutit à un résultat doivent rester des formules.
Merci pour les explications en tout cas ça m'aide à comprendre un peu plus mon "jeu de légo"

Je teste encore et vous redis ça!

 

[Anais51]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

J'ai refait la macro en suivant le B A BA:

1. Vas dans VBA via ALT+F11
2. CTRL + R pour accéder au VBA project
3. Double clique sur Thisworkbook
4. Dans la fenetre de droite au - dessus clique sur la fenetre déroulante et choisis 'WOrkbook'
5. Toujours dans la même fenetre, dans la liste déroulante de droite choisis l'option'Beforeclose'
6. Insére ta macro et enregiste le classeur.

Et là, la macro de Hasco fonctionne mais elle copie colle toute les cellules de ma plage même celles qui sont vides... Donc je crois qu'il faut modifier un détail je cherches...

 

[Anais51]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Je séche... Je viens de passer mon aprem dessus, je n'y arrive pas par moi-même:
Il me faut uniquement copier coller les cellules ayant eu un résultat avec leur formule différent de "". La formule d'Hasco est super mais toutes les formules des cellules sans valeurs ont disparus. Celle de Gorfaeal fait de même: copie colle les cellules ayant obtenu une valeur ou non.

 

[James007]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Bonjour,

Hasco a pris le soin de mettre des commentaires dans son code pour que tu comprennes ...
'Ne tient compte que des cellules ayant une formule

Peut-être dois-tu modifier ta plage ...???

Sans fichier, impossible de t'aider plus avant ...

Toutes nos boules de crystal sont en panne ... !!!


A +

 

[Gorfael]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Salut Anais51 et le forum

Il me faut uniquement copier coller les cellules ayant eu un résultat avec leur formule différent de ""

Si tu avais commencé par là, tu aurais déjà ta réponse ! Tu donnes une macro avec un test Empty(C) => on te rends une macro avec le même test ! On n'est ni télépathe, ni devin ! On essaie de résoudre un problème avec ce que tu nous donnes !
If not(Emty(Cel)) Then : Si la cellule contient quelque chose (une formule, un nombre ou un texte)
if Cel<>"" then : si la valeur de la cellule n'est vide
A+

 

[Guest]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Re,
hello James,

Pour ne retourner que les cellules qui ont une formule avec un résultat: soit un nombre soit un texte:

Set Plage_Cible = Sh.Range("E9:K22").SpecialCells(xlCellTypeFormulas,xlNumbers +xlTextValues)

remarquer les paramètres ajoutés: ,xlNumbers +xlTextValues

Mais ce que dis James est très juste. Nos boules de cristal sont enfumées et notre Super David , n'a pas les moyens de nous en offrir d'autres. Faut s'y faire.

A+

 

[Anais51]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Oui j'ai vu ses commentaires, c'est pour cela qu'au début j'ai tenté de modifier principalement par moi même. Mais je n'y suis pas arrivée.
Je ne pensais pas qu'un exemple puisse vraiment aider mais si vous voulez je joind un exemple d'onglet.

Alors mon programme constitue en un suivit des affaires.
On copie la base de donnée tout les mois dans un onglet spécifique. Pour chaque nouvelles affaires un onglet comme celui joind se crée avec en petit nom le nom de l'affaire et dans la cellule clé le n° de l'affaire. On a environ 50 onglets d'affaires dans ce types.
Le principe est simple, tant que les dates des dernières modifications de facturation ou d'unité d'oeuvre n'ont pas changé les lignes suivantes restent libres. Quand la date change, toute une lignes de nouveaux résultats apparaît.
Pour que l'historique soit valable il faut bien entendut que les résultats une fois obtenu se figent. Sinon on aura toujours qu'une seule ligne dans mon tableau d'historique.

J'avais donc pensé à faire une macro qui permet de garder uniquement les valeurs quand les formules ont aboutit à un résultat à la fermeture du fichier. Et c'est là que je bloque...

N'y arrivant vraiment pas je suis venue demander de l'aide.

Merci d'avance!

EDIT: Nos posts ce sont croisé Hasco j'ai fait tes modifs mais ça ne marche toujours pas j'essaye dans ce sens
Gorfael, Hasco est plus proche de ce que je veux faire, j'ai essayé de mélanger un peu des deux mais je n'y suis pas arrivée.

Après je suis désolée mais étant une grande débutante en VBA et étant nulle en anglais je n'ai pas fait la différence entre Estempy, nothing et <> "". Surtout que <> "" je n'ai pas réussit à l'appliquer à la formule de Hasco par exemple.

 

[Guest]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Re, Anais

Il n'y a aucune données dans ton fichier. Il nous faut quelque données (non confidentielles) ainsi que nous expliquer clairement le mode opératoire avec exemple de ce que tu veux obtenir, les noms des onglets dont il ne faut pas tenir compre etc... bref quelque chose qui ressemble vraiment à ce que tu as et à ce que tu désires obtenir.

Un exemple de ta zone nommée 'Tabl' serait bienvenue également

A+

 

[Anais51]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Epurer au maximum je crains qu'il ne dépasse la taille requise.

Alors voici dans un premier temps les différentes macros qui la composent:

Sub creerFeuilles()
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Nouvelles Affaires").Range("A2")
While curCell.Value <> vbNullString
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value

Sheets("Affaire Vierge").Select
Cells.Copy
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Select
Cells.Select
ActiveSheet.Paste
Range("E2") = curCell.Value


ThisWorkbook.Sheets("Nouvelles Affaires").Hyperlinks.Add Anchor:=curCell.Offset(0, 1), Address:="", SubAddress:= _
"'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A1", TextToDisplay:="Acces Feuille"
Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Nouvelles Affaires").Select
End Sub

Sub suppFeuilles()
Dim curWsht As Worksheet
Application.DisplayAlerts = False
For Each curWsht In ThisWorkbook.Sheets
If curWsht.Name <> "Base" And curWsht.Name <> "Début" And curWsht.Name <> "Feuil1" And curWsht.Name <> "Affaires Existantes" And curWsht.Name <> "Affaire Vierge" And curWsht.Name <> "Nouvelles Affaires" Then curWsht.Delete
Next curWsht
ThisWorkbook.Sheets("Nouvelles Affaires").Columns(3).ClearContents
Application.DisplayAlerts = True
End Sub

Sub Début()
'
' Affiche feuilles programme

Sheets("Feuil1").Visible = True
Sheets("Affaire Vierge").Visible = True
Sheets("Nouvelles Affaires").Visible = True


'Copie et trie les données voulut en Feuil1

Sheets("Base").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Copy
Rows("60001:60001").Select
ActiveSheet.Paste
Range("P60002").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ">50000"
Range("A1:AZ30000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("A60001:AZ60002"), CopyToRange:=Range("A60004:AZ60004"), Unique:= _
False

ActiveWindow.SmallScroll Down:=33
Range("E126").Select
ActiveWindow.LargeScroll Down:=-1

Rows("60005:61000").Select
Selection.Copy
Sheets("Feuil1").Select
Rows("2:2").Select
ActiveSheet.Paste
Range("E1").Select
Selection.AutoFilter
Range("A1:AZ300").Sort Key1:=Range("E1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'Met les nouvelles Affaires dans un onglets spécial afin qu'elles soient traité.

Sheets("Nouvelles Affaires").Select
Range("A1").Select
Selection.AutoFilter
Range("A2:A532").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=IF(Feuil1!RC[4]="""","""",IF(ISNUMBER(VLOOKUP(Feuil1!RC[4],'Affaires Existantes'!R2C1:R178C2,1,FALSE)),"""",Feuil1!RC[4]))"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A838"), Type:=xlFillDefault
Range("A2:A838").Select
ActiveWindow.SmallScroll Down:=-962
Range("A1").Select
Selection.AutoFilter
Range("A2:A838").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'Crée un onglet par affaire et crée un lien vers ceux ci

Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Nouvelles Affaires").Range("A2")
While curCell.Value <> vbNullString
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value

Sheets("Affaire Vierge").Select
Cells.Copy
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Select
Cells.Select
ActiveSheet.Paste
Range("E2") = curCell.Value


ThisWorkbook.Sheets("Nouvelles Affaires").Hyperlinks.Add Anchor:=curCell.Offset(0, 1), Address:="", SubAddress:= _
"'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A1", TextToDisplay:="Acces Feuille"
Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Nouvelles Affaires").Select


'Mets les nouvelles affaires avec celles existante

Sheets("Nouvelles Affaires").Select
Range("A2:A400").Select
Selection.Copy
Sheets("Affaires Existantes").Select
Range("A200").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A18").Select
Application.CutCopyMode = False
Sheets("Nouvelles Affaires").Select
Range("B2:B400").Copy
Sheets("Affaires Existantes").Select
Range("B200").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2:B300").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Nouvelles Affaires").Select
Range("A2:C400").ClearContents


'Masques feuilles programme

Sheets("Feuil1").Visible = False
Sheets("Affaire Vierge").Visible = False
Sheets("Nouvelles Affaires").Visible = False

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Plage_Cible As Range
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "Affaire Vierge" And sh.Name <> "Affaires Existantes" And sh.Name <> "Nouvelles Affaires" And sh.Name <> "Feuil1" And sh.Name <> "Base" Then
On Error Resume Next
'Ne tient compte que les cellules ayant une formule
Set Plage_Cible = sh.Range("E9:K22").SpecialCells(xlNumbers, xlTextValues)
'S'il y en a leur résultat sera conservé
If Not Plage_Cible Is novalue Then Plage_Cible.Value = Plage_Cible.Value
Set Plage_Cible = Nothing
End If
Next
ActiveWorkbook.Save
End Sub

Et il y a 6 onglets
"Début" Qui explique comment faire
"Base" qui contient la base de donnée
"Feuil1" qui est une étape de traitement de données
"Affaire vierge" qui est l'onglet précédament envoyé
"Affaires Existantes" qui contient les affaires déjà mis sous formes d'onglet avec leur lien qui vont direct sur l'onglet
"Nouvelles Affaires" qui viens d'extraire les nouvelles affaires et qui crée les nouveaux onglets avant de se recopier dans Affaires Existantes.



EDIT: La zone "Tabl" est en fait toute la zone situé en feuil1 qui contient les données elle doit être de E2 à AZ60000. La macro qui supprime les onglets sert uniquement à ma phase test. En effet elle est bien pratique et m'évite de supprimer les 50 onglets à chaque échecs de la dernière macro...
Et c'est tout. Les autres onglets se créent à l'identique d'"Affaire Vierge" avec les Affaires extraites de la base.

Je n'ai pas tapé tout le programme, j'ai réussit à touver des données par ci par là que j'ai adapté à ce que je voulais en faire. C'est pour cela que des parties vont vous sembler bien écrites et d'autres digne du parfait débutant que je suis. Vous comprendrez pourquoi j'appelles ça mon "jeu de légo".

 

[Guest]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Re,

Non, je ne vais pas recréer tout un classeur et ses macros.

Alors d'après ce que j'ai pu comprendre, voici les amélioration du corps de la macro.
Elle conserve les valeurs des cellules dont les formules renvoie des nombres, texte ou valeur logiques
Elle vide les cellules renvoyant des valeurs d'erreur.

    Dim Plage_Cible As Range
    Dim sh As Worksheet
    For Each sh In Worksheets
       If sh.Name <> "Nom1" And sh.Name <> "Nom2" Then
            On Error Resume Next
            
            'Ne tient compte que les cellules ayant une formule renvoyant des textes,des nombres et valeurs logiques
            Set Plage_Cible = Range("E9:K22").SpecialCells(xlCellTypeFormulas, xlNumbers + xlTextValues + xlLogical)
            
            'S'il y en a leur résultat sera conservé
            If Not Plage_Cible Is Nothing Then Plage_Cible.Value = Plage_Cible.Value
            Set Plage_Cible = Nothing
            
            'Ne tient compte que des cellules renvoyant des erreurs
            Set Plage_Cible = Range("E9:K22").SpecialCells(xlCellTypeFormulas, xlErrors)
            
            'S'il en existe elle seront vider
            If Not Plage_Cible Is Nothing Then Plage_Cible.ClearContents
                      
        End If
    Next

A+

 

[Anais51]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Ca ne marche toujours pas, il ne faut pas que les cellules qui contiennent des formules mais qui n'ont pas obtenu de résultat soient vidé. Les formules doivent rester tant qu'elles n'ont pas obtenu une valeur. Or là les cellules contenant des formules deviennent des cellules totalement vide. J'aimerais qu'elles conservent définitivement leur résultat quand elles en ont obtenu un et qu'elles restent des formules tant que ce n'est pas le cas...

Je sais que ce n'est pas facile de se comprendre via internet et je te remercie vivement des efforts que tu fais!

Mon soucis ne viens pas du fait que j'ai des erreurs qui s'affichent mais de ces cellules qui n'ont pas encore remplis leur rôle qui perdent leur précieuse formules ou, à l'inverse, de ces cellules qui ont remplis leur rôle et qui gardent leur formules

 

[Gorfael]

Re : VBA Macro copie/colle valeur cellule non vide à la fermeture

Salut Anais51 et le forum
Pas sûr que tu ais compris ce qu'on demande sur un fichier d'essai :
- Un fichier d'essai n'est pas un document de travail
- il peut être formaté pareil ou non : le but c'est qu'il nous explique ce que le travail demandé doit faire.

Sur ton "fichier d'essai", 3 feuilles une avec des formules, des mise en forme, mais aucune valeur : toutes tes formules font référence à un classeur externe.
2ème et 3ème feuilles vides : pourquoi les mettre ?

Ce que j'aurais aimé :
Feuille 2 : une plage avec quelques valeurs significatives
Feuille 1 : quelques valeurs apparentes
Feuille 3 : ce que tu voudrais récupérer et comment !

Ce que je crois comprendre :
S'il y a une valeur en I sur la plage 9 à 22, à la sortie, on fige la ligne concernée pour les cellules de E à K. Si c'est ça, teste cette macro :

Sub test()
Dim X As Long, Y As Integer
For X = 9 To 22
    If Range("I" & X) <> "" Then
        Range(Cells(X, "E"), Cells(X, "K")) = Range(Cells(X, "E"), Cells(X, "K")).Value
    Else
        Exit For
    End If
Next X
End Sub

Tu te crées un numéro d'affaire et tu le fais évoluer comme il devrait le faire. Au lieu de fermer, tu relances la macro. Une fois que le code sera bon, on fera qu'elle se déclenche au bon moment sur la bonne feuille.

Sinon tu essaies d'expliquer un état de départ, puis une modification et l'état d'arrivée.

Ne connaissant pas la manière d'utiliser le fichier, n'ayant même pas un exemple, je ne peux qu'imaginer. Mais pour moi, on doit travailler en ligne, et pas cellule par cellule.
Un petit doute subsiste : les formules font référence à I, sauf K qui fait référence à L4 et J qui fait référence à K. il faudrait, peut-être, prévoir 2 tests :
- un qui s'appuie sur I et qui concerne les colonnes de E à I
- un qui s'appuie sur K et qui concerne J et K
Mais ça, seul un utilisateur du fichier peut le dire
A+