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.

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

VBA EXCEL copier jusqu'a la fin du fichier

Réponse 41 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 13:39

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.

Réponse 42 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 13:39

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.

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 13:47

Alors au niveau de la formule j'en ai aucune idée!
Mais pour les if, il faut mettre un then je crois:

if condition then

End if

Réponse 43 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 13:48

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.

Réponse 44 / 60

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 13:51

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))"""

Réponse 45 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 13:53

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

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 13:55

Ben alors essaye de le mettre dans la premiere cellule et de la copier coller

avec un:

activesheet.cells(1,24).copy
activesheet.cells(introw,24).paste

Réponse 46 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:01

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

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 14:03

Tu peux modifier le titre de ta macro le temps de la tester comme j'avais fais moi.

Réponse 47 / 60

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 293
1 juil. 2009 à 14:04

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...

Réponse 48 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:09

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

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 14:11

oui normal, en fait si tu utilises cette méthode, il faut que utilise une variable differente, introw2 par exemple, et que tu l'initialise à 2 au lieu de 1.

Réponse 49 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:18

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

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 14:37

Non normalement l'activesheet suivant il devrais marcher en introw!

Réponse 50 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:39

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

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 14:40

C'est laquelle de ligne exactement?
quelle erreur?

Réponse 51 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:41

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

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 14:42

Si tu remplaces la formule par un "test" ca marche?

Réponse 52 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:47

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)"

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
1 juil. 2009 à 14:47

oui bon ben en gros c t formules qui sont pourris quoi xD
non faut regarder comment faire pour mettre une formule correctement.

Réponse 53 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 14:49

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

Réponse 54 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
1 juil. 2009 à 16:06

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

Réponse 55 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
2 juil. 2009 à 09:08

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

Réponse 56 / 60

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
2 juil. 2009 à 09:30

Déjà inverse les introw et les chiffres:

activesheet.cells(introw, 24). value

Réponse 57 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
2 juil. 2009 à 09:40

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.

Réponse 58 / 60

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
2 juil. 2009 à 09:46

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

Réponse 59 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
2 juil. 2009 à 09:55

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

Réponse 60 / 60

Fou_Du_Guidon Messages postés 320 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 9 juillet 2010 38
2 juil. 2009 à 10:16

WAOUHHHHHHHHHHHH tout fonctionne mille merci. YEAHHHHHHH =D

xav3601 Messages postés 3288 Date d'inscription lundi 10 novembre 2008 Statut Membre Dernière intervention 2 mars 2016 311
2 juil. 2009 à 10:40

:D
J'étais sur qu'on finirait par y arriver lol

VBA EXCEL copier jusqu'a la fin du fichier

60 réponses

Discussions similaires