VBA EXCEL copier jusqu'a la fin du fichier

Résolu
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   -  
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   -
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.
A voir également:

60 réponses

Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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.
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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.
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
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
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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.
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
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))"""
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
Non...en C++ faut doubler le signe mais ici sa ne fonctionne pas j'ai aussi essayer \ et /
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
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
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
Tu peux modifier le titre de ta macro le temps de la tester comme j'avais fais moi.
0
Bidouilleu_R Messages postés 1181 Date d'inscription   Statut Membre Dernière intervention   295
 
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...
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
Alors alors erreur 1004 sur cette ligne
ActiveSheet.Cells(24, introw).Value = ActiveSheet.Cells(24, introw - 1)
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
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.
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
Ok ok c'est passer à l'activesheet suivant qu'il faut aussi mettre en introw3?
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
Non normalement l'activesheet suivant il devrais marcher en introw!
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
Non j'ai tester avec introw, introw2 et introw3 sans résultats.
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
C'est laquelle de ligne exactement?
quelle erreur?
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
erreur d'exécution 1004 sur la ligne
ActiveSheet.Cells(25, introw).Value = "=RECHERCHEV(W2;'Communes BEX'!$A$2:$C$601;3;FAUX)"
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
Si tu remplaces la formule par un "test" ca marche?
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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)"
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
oui bon ben en gros c t formules qui sont pourris quoi xD
non faut regarder comment faire pour mettre une formule correctement.
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
;-( elles sont pas pourries...je les ai fait avec amours et patience.
FormulaR1C1 fonctionne mais comment ca fonctionne ??? O_O???
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
J'ai essayer avec l'enregistreur de macro pour traduire mes formules mais sa ne fait pas se que je désire.
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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

0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
Déjà inverse les introw et les chiffres:

activesheet.cells(introw, 24). value
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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.
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
remet ton code actuel qui marche a peu près xD
Je le modifierais apres!
0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
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

0
Fou_Du_Guidon Messages postés 320 Date d'inscription   Statut Membre Dernière intervention   38
 
WAOUHHHHHHHHHHHH tout fonctionne mille merci. YEAHHHHHHH =D
0
xav3601 Messages postés 3289 Date d'inscription   Statut Membre Dernière intervention   311
 
:D
J'étais sur qu'on finirait par y arriver lol
0