VBA EXCEL copier jusqu'a la fin du fichier Résolu

Question

Bonjour, je repost içi je pense que c'est plus approprier :-)
J'ai un petit souci avec EXCEL, je voudrai automatiser des actions avant la fermeture (beforeclose) car mes utilisateurs ne sont pas trés pousser niveau informatique donc faut les aider au maximum...Donc il faut que sa copie le contenu de 4 colonnes jusqu'à la fin de la feuille. J'ai trois colonnes de formules et une de date si on pouvait même faire une textbox qui demanderai la date et qui la copierai jusqu'à la fin sa sera cool mais ce n'est pas le principal. Donc voila je demande votre aide et je vous remercis d'avance.

xav3601 · Accepted Answer

voilà la solution, en tout cas j'espere \o/

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


letemps = Time ' heure du système.

ladate = Format(InputBox("Donner la date SVP...", "Saisie de la date", Date), "dd/mm/yyyy")

ladate = ladate & "_" & letemps

introw = 1


While ActiveSheet.Cells(introw, 1) <> ""

If ActiveSheet.Cells(introw, 23).Value = "" Then
'ActiveSheet.Cells().Value = "=RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
ActiveSheet.Cells(introw, 23).FormulaR1C1 = "=VLOOKUP(RC[-19],'Commune CAD PDL'!C[-22]:C[-21],2,FALSE)"
End If
If ActiveSheet.Cells(introw, 24).Value = "" Then
ActiveSheet.Cells(introw, 24).Value = ladate
End If
If ActiveSheet.Cells(introw, 25).Value = "" Then 'ActiveSheet.Cells(introw, 25).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
ActiveSheet.Cells(introw, 25).FormulaR1C1 = "=VLOOKUP(RC[-2],'Communes BEX'!R2C1:R601C3,3,FALSE)"
End If
If ActiveSheet.Cells(introw, 34).Value = "" Then
'ActiveSheet.Cells(introw, 34).Value = "=SI(NBCAR(F2)<8;"*Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))"
ActiveSheet.Cells(introw, 34).FormulaR1C1 = "=IF(LEN(RC[-28])<8,""Non Référencé"",IF(RIGHT(RC[-28],6)=""000000"",""Non Référencé"",RC[-28]))"
End If

introw = introw + 1
Wend

End Sub

Fou_Du_Guidon · Answer

B'jour, en faite en relisant sa le fait pas trop :-/ j'ai besoins d'aide pour le code, je suis un peu (beaucoup) nul en VBA...le C/C++ je dit pas mais là...je galére grave. En piquant à droite à gauche j'ai chopé des lignes de code mais aprés comment les imbriquer les unes aux autres...I don't know.Donc si quelqu'un pouvait me débloquer sa serai genti
Merci ;-)

xav3601 · Answer

Salut!
Faudrait que tu expliques la structure de ton fichier excel plus en détails, et aussi montrer ce que tu as déjà plus ou moins fait ^^

Bidouilleu_R · Answer

Bonjour,

j'ai lu et relu, mais j'ai du mal à suivre.
petite remarque ... tu sais de quoi tu parles mais moi pas.

Je crois comprendre que la source (par exemple Colonne A B C D ) il y aurait une Date en A et Qu'il faudrait
copier/coller la ou les lignes après une date définie (en colonne A peut-être) dans une autre feuille.

Est-ce cela?

Précise La source (colonne /nom de feuille)
précise le but (colonne /nom de feuille) 
le format des données (valeurs ou formule)

Tu dis et j'essaye de t'aider.

A+

Fou_Du_Guidon · Answer

Ahh merci. Mon code n'a pas été sauvegarder hier soir ( oublie de ma part :-/ faut dire qu'il l'avais chercher...) donc je peux toujours retrouver la structure du beforeclose dans le worktruc , j'avais trouvé la forme du TANT QUE et aprés plein de code différent pour tester une cellule vide et copier/coller mais c'est tout.
Mon fichier se présente comme ca. 
A B C D E ... W X Y ....AH avec le nombre de lignes de toutes les colonnes sont égal mais pas fixe.
W -> Formule RECHERCHEV
X -> Date à mettre (pour l'instant à la main même si j'aimerai le faire en Textbox)
Y -> Formule RECHERCHEV
AH -> Formule RECHERCHEV
Voila les 4 col que je rajoute, toutes les autres arrivent d'un vulgaire copier/coller.
Donc une fois que c'est copier pour l'instant je dois descendre les formules jusque en bas (pour moi sa me prend 2s mais pour les autres...sa prend facile la minute :-/ )
Je sais pas si sa t'aide pour le moment, mais merci.

Fou_Du_Guidon · Answer

petite précision je rejoute toute les collones à partir de W 
Non de la feuille -> Fiches

xav3601 · Answer

Toujours rien compris o_O

Fou_Du_Guidon · Answer

Voila le fichier
http://www.cijoint.fr/cjlink.php?file=cj200907/cijkZBQcC4.xls 
Je pense que sa aidera à la comprehension, donc comme je le disais j'ai préremplie certaine colonnes mais si on rajoute beaucoup d'enregistrement il faudra copier les formules et la date vers la fin du fichier.

Bidouilleu_R · Answer

j'ai lu 3 fois ....
et je comprends xav3601.... tu ne réponds pas aux questions.

je comprends Ca!

W -> Formule RECHERCHEV 
X -> Date à mettre (pour l'instant à la main même si j'aimerai le faire en Textbox) 
Y -> Formule RECHERCHEV 
AH -> Formule RECHERCHEV 

en fait tu voudrais écrire en "Automatique" les formules déjà existante en Wnn , la date en Xnn, et ..
à nouveau 2 formules en Ynn et AHnn ( nn représente le n° de ligne)

pour la date je conseille d'utiliser un inputbox plutôt qu'un textbox (ce sera plus souple).

sub test()
Dim ladate As Date
ladate = Format(InputBox("Donner la date SVP...", "Saisie de la date", Date), "dd/mm/yyyy")
    Range("X1").Select
    Selection.End(xlDown).Select 'dernière ligne pleine
    ActiveCell.Offset(1, 0).Select  ' ligne suivante ou première ligne vide
' il ne doit pas y avoir de "vide dans les dates"
    activecell.value=ladate
'    tu vas en W ( recul de 1 colonne )
activecell.offset(0,-1).select

ActiveCell.FormulaR1C1 = " recopie ici la formule de rechercheV "
'tu vas en Y
activecell.offset(0,2).select
ActiveCell.FormulaR1C1 = " recopie ici la formule en utilisant l'enregistreur de macro.."
' tu es en Y tu vas en AH
activecell.offset(0,9).select

ActiveCell.FormulaR1C1 = " recopie ici la formule en utilisant l'enregistreur de macro.."


' ensuite tu peux sauvegarder
' Activeworkbook.save


end sub

Fou_Du_Guidon · Answer

http://www.cijoint.fr/cjlink.php?file=cj200907/cijXO2KLnD.xls 
J'ai fait un fichier tel qu'il serai actuellement (en allégé) les colonnes avant W sont remplie par un copier/coller.
on peut voir que les autres ne sont pas remplie et c'est ce qu'il faut automatiser, que les colonnes désirées soient aussi remplies. J'éspère avoir été compris :-/
Pour ton code Bidouilleu_R c'est la inputBox ? je travail sur la compréhension actuelement.

xav3601 · Answer

Je crois avoir compris...
Ta colonne A est rempli, et tu voudrais qu'on fasse un copier coller des formules présentes dans les cellule w1 x1 y1 ah1 dans les cellules en dessous jusqu'à la derniere ligne rempli dans la colonne A?

Fou_Du_Guidon · Answer

OUUUIII c'est ca :D YES! J'ai un petit souci avec ton code Bidouilleu_R. Avec la derniére ligne où je doit mettre la formule RECHERCHEV j'ai une erreur.
Comment fonctionne l'enregistreur de macro?

xav3601 · Answer

Ok ba alors si c'est rien de plus simple pour ta macro ^^

introw=1

Do until activesheet.cells(1, introw) <> "" 

Activesheet.cells(25,introw)= formule
Activesheet.cells(24,introw)= formule
Activesheet.cells(23,introw)= formule
Activesheet.cells(,introw)= formule

introw=introw + 1
Loop

Fou_Du_Guidon · Answer

O_o pourrai tu m'expliquer un peu s'il te plait?

Fou_Du_Guidon · Answer

OK donc combiner la inputBox avec ton code sa pourrai donner sa?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   Dim ladate As Date 
   ladate = Format(InputBox("Donner la date SVP...", "Saisie de la date", Date), "dd/mm/yyyy") 
   Range("X1").Select
   introw=1 

   Do until activesheet.cells(1, introw) <> "" 

   Activesheet.cells(25,introw)= formule
   Activesheet.cells(24,introw)= ladate
   Activesheet.cells(23,introw)= formule 
   Activesheet.cells(,introw)= formule 

   introw=introw + 1 
   Loop
End Sub

Récapitulation sa met la Formule pour W1 , la date renseigner dans la box dans X1, la formule pour Y1 et la formule pour AH1 puis sa passe à la deuxiéme ligne et rebelote...
Non?!?

Fou_Du_Guidon · Answer

ma colonne X correspond à une date pas une formule. Et Bidouilleur ma je pense donné le code d'une inputbox donc ladate doit correspondre à la variable de stockage de la box. On renseigne une fois la date et sa la copie jusqu'a la fin. Par contre si je rajoute des lignes et que précédamment tous était correctement remplies est-ce que sa va recopier encore les formules?

Fou_Du_Guidon · Answer

J'ai une erreur de compilation je pense que c'est à cause des " mais je ne sias pas réglé le problème. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim ladate As Date ladate = Format(InputBox("Donner la date SVP...", "Saisie de la date", Date), "dd/mm/yyyy") Range("X1").Select Selection.End(xlDown).Select 'dernière ligne pleine ActiveCell.Offset(1, 0).Select ' ligne suivante ou première ligne vide ' il ne doit pas y avoir de "vide dans les dates" ActiveCell.Value = ladate introw = 1 Do Until ActiveSheet.Cells(1, introw) <> "" ActiveSheet.Cells(25, introw) = "RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)" ActiveSheet.Cells(24, introw) = ActiveSheet.Cells(24, introw - 1) ActiveSheet.Cells(23, introw) = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)" ->>>ActiveSheet.Cells(, introw) = "=SI(NBCAR(F2)<8;"Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))" introw = introw + 1 Loop End Sub

Bidouilleu_R · Answer

Je suis obligé de vous laisser mais je vois que vous avez bien progréssé.
au post 11 tu dis
Comment fonctionne l'enregistreur de macro? 

en excel 2003 : outils.macro/enregistrer une macro appelle là "toto"
click sur une formule valide en appuyant sur entrée passe à la formule suivante.

quand tu as fini outils/macro/arrêter l'enregistreur.
Alt F11 (il y a un nouveau module avec la macro toto) tu trouveras la syntaxe.

Je vous laisse. 
Bon courage.

Fou_Du_Guidon · Answer

Autre petite question ^^ j'ai besoin de l'heure aussi. Comment je fait? j'ai essayer de rajouter le format derriére la date mais errer de compil aussi.

Bidouilleu_R · Answer

ActiveSheet.Cells(!!!!!, introw) = "=SI(NBCAR(F2)<8;"Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))" 

A cet endroit il faut un chiffre.
Pour l'heure Fonction time


Dim letemps as time
letemps=time ' heure du système.
utilise aussi la fonction format comme ça    format  (letemps,"hh:mm:ss")

Fou_Du_Guidon · Answer

>< oops j'ai donc mis le chiffre, rajouter l'heure mais j'ai toutjours un erreur de compilation sur la ligne Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim letemps As Time letemps = Time ' heure du système. Dim ladate As Date ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy") Range("X1").Select Selection.End(xlDown).Select 'dernière ligne pleine ActiveCell.Offset(1, 0).Select ' ligne suivante ou première ligne vide ' il ne doit pas y avoir de "vide dans les dates" ladate = ladate & "_" & letemps ActiveCell.Value = ladate introw = 1 Do Until ActiveSheet.Cells(1, introw) <> "" ActiveSheet.Cells(23, introw) = "RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)" ActiveSheet.Cells(24, introw) = ActiveSheet.Cells(24, introw - 1) ActiveSheet.Cells(25, introw) = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)" ActiveSheet.Cells(34, introw) = "=SI(NBCAR(F2)<8;"Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))" introw = introw + 1 Loop End Sub

Fou_Du_Guidon · Answer

Erreur compilation 
expression attendue

Fou_Du_Guidon · Answer

Donc sa vient bien de la formule et mais en recompilant une autre apparait sur la ligne Dim letemps As Time avec type définie par l'utili.. non définie :-/

Fou_Du_Guidon · Answer

YEAHHHH sa fonctionne!!!!...presque:-( . Sa fonctionne juste pour la date. Les 3 formules ne sont pas copier..

Fou_Du_Guidon · Answer

Euh..je le met ou? Sur la boucle ou avant? Normalement la boucle devrait commencer ?

Fou_Du_Guidon · Answer

OULA toutes les cellules sont remplies avec la date et l'heure quand je dit toutes c'est toutes 65355 et quelque lignes, toutes les colonnes...

Fou_Du_Guidon · Answer

J'avoue j'ai sourie et j'étais content lorsque le traitement à commencer , mais j'ai vite déchanté ^^

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    
    letemps = Time ' heure du système.
    
    ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy")
    
    Range("X1").Select
    Selection.End(xlDown).Select 'dernière ligne pleine
    ActiveCell.Offset(1, 0).Select ' ligne suivante ou première ligne vide
    ' il ne doit pas y avoir de "vide dans les dates"
    ladate = ladate & "_" & letemps
    ActiveCell.Value = ladate

    introw = 1
    
    Do Until ActiveSheet.Cells(1, introw) <> ""
    
        ActiveSheet.Cells(23, introw) = "RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
        ActiveSheet.Cells(24, introw) = ActiveSheet.Cells(24, introw - 1)
        ActiveSheet.Cells(25, introw) = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
        ActiveSheet.Cells(34, introw) = "test"
        
        introw = introw + 1
    Loop

End Sub

Fou_Du_Guidon · Answer

Rien ne se passe...

Fou_Du_Guidon · Answer

Même chose

Fou_Du_Guidon · Answer

Il y a la Box qui s'affiche puis un petit coup de sablier et pis c'est tout. Je vois pas comment exécuter en pas à pas.

Bidouilleu_R · Answer

click dans la macro puis f8
tu verras la ligne surlignée en jaune avant d'être executé.

Fou_Du_Guidon · Answer

Il faudrai que je sauvegarde ma macro dans se cas. Comment faire je n'arrive pas à sauvegarder de macro dans le Workbook.

xav3601 · Answer

Je suis con xD
Comme ca ca marche:

Private Sub macro()


letemps = Time ' heure du système.

ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy")

ladate = ladate & "_" & letemps

introw = 1


Do Until ActiveSheet.Cells(introw, 1).Value = ""

ActiveSheet.Cells(introw, 23) = "test"
ActiveSheet.Cells(introw, 24) = "test"
ActiveSheet.Cells(introw, 25) = "test"
ActiveSheet.Cells(introw, 34) = "test"

introw = introw + 1
Loop

End Sub

Bidouilleu_R · Answer

essaye ça !Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 


letemps = Time ' heure du système. 

ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy") 

ladate = ladate & "_" & letemps 

introw = 1 



While ActiveSheet.Cells(1, introw) <> ""

ActiveSheet.Cells(23, introw).Value = "RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
ActiveSheet.Cells(24, introw).Value = ActiveSheet.Cells(24, introw - 1)
ActiveSheet.Cells(25, introw).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
ActiveSheet.Cells(34, introw).Value = "test"

introw = introw + 1
Wend
end sub

Bidouilleu_R · Answer

Pardon les post se sont croisés

Fou_Du_Guidon · Answer

Sa à fonctionner, mais sa à remplacer toutes mes cellules par "test" il va bien jusqu'à la fin , mais toute la colonnes est remplacer par test.

Bidouilleu_R · Answer

Exact j'ai fait un copier coller de l'entête précédente.
C'est ta méthode qui est la bonne.

Fou_Du_Guidon · Answer

Pour le code de bidouille -> erreur 1004 sur cette ligne
ActiveSheet.Cells(24, introw).Value = ActiveSheet.Cells(24, introw - 1)
Bon je vous remercie pour l'instant de votre aide mais la je vais manger bonne app à vous deux et à tout à l'heure.

Fou_Du_Guidon · Answer

Oui oui je sais que sa met "test" mais sa ma remplacer aussi ce qui été déjà remplie, c'est pour ca!

Fou_Du_Guidon · Answer

Lol on c'est mal compris je pense, il faut que ca remplisse les cellules vides jusqu'à la derniére ligne mais sans remplacer les précédent enregistrement ni l'entete de colonne

Fou_Du_Guidon · Answer

Voila se que ca donne
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


letemps = Time ' heure du système.

ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy")

ladate = ladate & "_" & letemps

introw = 1



While ActiveSheet.Cells(1, introw) <> ""

if Activesheet.cells(23, introw).Value = ""
    ActiveSheet.Cells().Value = "=RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
End If
if ActiveSheet.Cells(24, introw).Value = ""
    ActiveSheet.Cells(24, introw).Value = ActiveSheet.Cells(24, introw - 1)
End If
if ActiveSheet.Cells(25, introw).Value = ""
ActiveSheet.Cells(25, introw).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
End If
if ActiveSheet.Cells(34, introw).Value = ""
    ActiveSheet.Cells(34, introw).Value = "=SI(NBCAR(F2)<8;"*Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))"
End If
    

introw = introw + 1
Wend
End Sub

Mais problème au niveau des IF je vais regarder la syntaxe et Problème aussi sur la dernière formule à partir de *. Donc je regarde sa.

Fou_Du_Guidon · Answer

Voila se que ca donne
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


letemps = Time ' heure du système.

ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy")

ladate = ladate & "_" & letemps

introw = 1



While ActiveSheet.Cells(1, introw) <> ""

if Activesheet.cells(23, introw).Value = ""
    ActiveSheet.Cells().Value = "=RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
End If
if ActiveSheet.Cells(24, introw).Value = ""
    ActiveSheet.Cells(24, introw).Value = ActiveSheet.Cells(24, introw - 1)
End If
if ActiveSheet.Cells(25, introw).Value = ""
ActiveSheet.Cells(25, introw).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
End If
if ActiveSheet.Cells(34, introw).Value = ""
    ActiveSheet.Cells(34, introw).Value = "=SI(NBCAR(F2)<8;"*Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))"
End If
    

introw = introw + 1
Wend
End Sub

Mais problème au niveau des IF je vais regarder la syntaxe et Problème aussi sur la dernière formule à partir de *. Donc je regarde sa.

Fou_Du_Guidon · Answer

Arf j'ai poster 2 fois...tant pis j'ai réglé le problème du IF avec then mais je bloque toujours pour le probléme des " car je pense que c'est sa.

xav3601 · Answer

Ah oui c'est carrement ca même ^^
Ca par contre je sais plus comment on fais, en vbs y'a une histoire de mettre plusieurs " du genre:

"""=SI(NBCAR(F2)<8;"Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))"""

Fou_Du_Guidon · Answer

Non...en C++ faut doubler le signe mais ici sa ne fonctionne pas j'ai aussi essayer \ et /

Fou_Du_Guidon · Answer

Arf j'ai la 1ere ligne en jaune 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
c'est pour sa que je n'arrive pas à sauvegarder...je pense

Bidouilleu_R · Answer

j'ai repris la formule avec l'enregistreur


ActiveCell.FormulaR1C1 = _
        "=IF(LEN(RC[-28])<8,""Non Référencé"",IF(RIGHT(RC[-28],6)=""000000"",""Non Référencé"",RC[-28]))"

ou

ActiveSheet.Cells(34, introw).formular1c1="=IF(LEN(RC[-28])<8,""Non Référencé"",IF(RIGHT(RC[-28],6)=""000000"",""Non Référencé"",RC[-28]))"

si cela peut aider...

Fou_Du_Guidon · Answer

Alors alors erreur 1004 sur cette ligne 
ActiveSheet.Cells(24, introw).Value = ActiveSheet.Cells(24, introw - 1)

Fou_Du_Guidon · Answer

Ok ok c'est passer à l'activesheet suivant qu'il faut aussi mettre en introw3?

Fou_Du_Guidon · Answer

Non j'ai tester avec introw, introw2 et introw3 sans résultats.

Fou_Du_Guidon · Answer

erreur d'exécution 1004 sur la ligne
ActiveSheet.Cells(25, introw).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"

Fou_Du_Guidon · Answer

Oui mais à présent l'erreur remonte O_O? sur cette ligne (erreur 1004)
ActiveSheet.Cells().Value = "=RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"

Fou_Du_Guidon · Answer

;-( elles sont pas pourries...je les ai fait avec amours et patience.
FormulaR1C1 fonctionne mais comment ca fonctionne ??? O_O???

Fou_Du_Guidon · Answer

J'ai essayer avec l'enregistreur de macro pour traduire mes formules mais sa ne fait pas se que je désire.

Fou_Du_Guidon · Answer

Bonjour, plus que deux jour avant la fin de mon stage :D , mais je n'est pas avancé (sa ne compile toujours pas!)
j'ai une erreur 13 apparamment de type au 1er IF donc à mon avis aux autre aussi.
je met le code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


    letemps = Time ' heure du système.
    
    ladate = Format(InputBox("Donner la date et l'heure SVP...", "Saisie de la date", Date), "dd/mm/yyyy")
    
    ladate = ladate & "_" & letemps
    
    introw = 1
    introw2 = 2
    
    
    While ActiveSheet.Cells(1, introw) <> ""
    
    If ActiveSheet.Cells(23, introw).Value = "" Then
        'ActiveSheet.Cells().Value = "=RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
        ActiveSheet.Cells(23, introw).FormulaR1C1 = "=VLOOKUP(RC[-19],'Commune CAD PDL'!C[-22]:C[-21],2,FALSE)"
    End If
    If ActiveSheet.Cells(24, introw2).Value = "" Then
        ActiveSheet.Cells(24, introw2).Value = ActiveSheet.Cells(24, introw - 1)
    End If
    If ActiveSheet.Cells(25, introw).Value = "" Then
        'ActiveSheet.Cells(25, introw).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
        ActiveSheet.Cells(25, introw).FormulaR1C1 = "=VLOOKUP(RC[-2],'Communes BEX'!R2C1:R601C3,3,FALSE)"
    End If
    If ActiveSheet.Cells(34, introw).Value = "" Then
        'ActiveSheet.Cells(34, introw).Value = "=SI(NBCAR(F2)<8;"*Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))"
        ActiveSheet.Cells(34, introw).FormulaR1C1 = "=IF(LEN(RC[-28])<8,""Non Référencé"",IF(RIGHT(RC[-28],6)=""000000"",""Non Référencé"",RC[-28]))"
    End If
    
    introw2 = introw2 + 1
    introw = introw + 1
    Wend
    
End Sub

xav3601 · Answer

Déjà inverse les introw et les chiffres:

activesheet.cells(introw, 24). value

Fou_Du_Guidon · Answer

XDDDD sa recopie les formules jusqu'a la fin c'est merveilleux !!!! Merci, mais vu qu'il faut toujours un problème (sinon se forum d'existerais pas :/) la inputbox ne sert à rien...je met la date dans la box mais se ne fait que recopier celle d'avant , et se termine une ligne aprés la fin du fichier...Donc si je met pas de date j'ai droit à l'entête de colonne.

xav3601 · Answer

remet ton code actuel qui marche a peu près xD
Je le modifierais apres!

Fou_Du_Guidon · Answer

voila la source du problème

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


    letemps = Time ' heure du système.
    
    ladate = Format(InputBox("Donner la date SVP...", "Saisie de la date", Date), "dd/mm/yyyy")
    
    ladate = ladate & "_" & letemps
    
    introw = 1
    introw2 = 2
    
    
    While ActiveSheet.Cells(introw, 1) <> ""
    
    If ActiveSheet.Cells(introw, 23).Value = "" Then
        'ActiveSheet.Cells().Value = "=RECHERCHEV(D2;'Commune CAD PDL'!A:B;2;FAUX)"
        ActiveSheet.Cells(introw, 23).FormulaR1C1 = "=VLOOKUP(RC[-19],'Commune CAD PDL'!C[-22]:C[-21],2,FALSE)"
    End If
    If ActiveSheet.Cells(introw2, 24).Value = "" Then
        ActiveSheet.Cells(introw2, 24).Value = ActiveSheet.Cells(introw2 - 1, 24)
    End If
    If ActiveSheet.Cells(introw, 25).Value = "" Then        'ActiveSheet.Cells(introw, 25).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
        ActiveSheet.Cells(introw, 25).FormulaR1C1 = "=VLOOKUP(RC[-2],'Communes BEX'!R2C1:R601C3,3,FALSE)"
    End If
    If ActiveSheet.Cells(introw, 34).Value = "" Then
        'ActiveSheet.Cells(introw, 34).Value = "=SI(NBCAR(F2)<8;"*Non Référencé";SI(DROITE(F2;6)="000000";"Non Référencé";F2))"
        ActiveSheet.Cells(introw, 34).FormulaR1C1 = "=IF(LEN(RC[-28])<8,""Non Référencé"",IF(RIGHT(RC[-28],6)=""000000"",""Non Référencé"",RC[-28]))"
    End If
    
    introw2 = introw2 + 1
    introw = introw + 1
    Wend
    
End Sub

Fou_Du_Guidon · Answer

WAOUHHHHHHHHHHHH tout fonctionne mille merci. YEAHHHHHHH =D

VBA EXCEL copier jusqu'a la fin du fichier

60 réponses

Discussions similaires

Newsletters