Copie conditionnée date - VBA
Bonjour,
Je me permets de solliciter votre aide pour la réalisation d'une macro.
J'ai besoin que ma macro déclenche une copie de toute la ligne du classeur "Automatisation" si la date présente dans la colonne E date de moins de 90 jours, et la colle dans le classeur "Carnet de bord". (En gros si il y a eu un changement sur la ligne, l'analyste change la date, s'il a changé la date, la ligne doit être copiée en valeur dans le classeur carnet de bord à la suite des précédentes).
J'ai rédigé un code mais rien ne se produit lorsque je le lance. Je m'apprête à m'arracher le scheveux par poignée, pourriez-vous m'aider? :)
Voici le code:
Sub Bouton1_Clic()
Dim Automatisation As Workbook, Carnetdebord As Workbook
Dim Colonne As Integer
Dim Ligne As Integer
Dim datedemodif As Date
Set Automatisation = Application.Workbooks.Open("S:\AD Conseil\Fonds\Automatisation.xlsm", , True)
Set Carnetdebord = ThisWorkbook
datedemodif = Automatisation.Sheets("Fonds").Range("E1").Value
Automatisation.Sheets("Fonds").Activate
For Ligne = 1 To 300
If datedemodif >= Now + 90 Then
EntireRow.Copy
Workbooks("Carnetdebord").Sheets("Import").Select
Ligne = Sheets("Import").Range("A3").End(xlDown).Row + 1
ActiveSheet.Paste
End If
Next
End Sub
Compte tenu de la lourdeur extrême du fichier, je ne pourrai malheureusement pas vous le transmettre.
Merci d'avance.
Je me permets de solliciter votre aide pour la réalisation d'une macro.
J'ai besoin que ma macro déclenche une copie de toute la ligne du classeur "Automatisation" si la date présente dans la colonne E date de moins de 90 jours, et la colle dans le classeur "Carnet de bord". (En gros si il y a eu un changement sur la ligne, l'analyste change la date, s'il a changé la date, la ligne doit être copiée en valeur dans le classeur carnet de bord à la suite des précédentes).
J'ai rédigé un code mais rien ne se produit lorsque je le lance. Je m'apprête à m'arracher le scheveux par poignée, pourriez-vous m'aider? :)
Voici le code:
Sub Bouton1_Clic()
Dim Automatisation As Workbook, Carnetdebord As Workbook
Dim Colonne As Integer
Dim Ligne As Integer
Dim datedemodif As Date
Set Automatisation = Application.Workbooks.Open("S:\AD Conseil\Fonds\Automatisation.xlsm", , True)
Set Carnetdebord = ThisWorkbook
datedemodif = Automatisation.Sheets("Fonds").Range("E1").Value
Automatisation.Sheets("Fonds").Activate
For Ligne = 1 To 300
If datedemodif >= Now + 90 Then
EntireRow.Copy
Workbooks("Carnetdebord").Sheets("Import").Select
Ligne = Sheets("Import").Range("A3").End(xlDown).Row + 1
ActiveSheet.Paste
End If
Next
End Sub
Compte tenu de la lourdeur extrême du fichier, je ne pourrai malheureusement pas vous le transmettre.
Merci d'avance.
2 réponses
-
Super ça marche!
Ma macro tourne et écrit, et elle est moins lourde que ma première version. je vous remercie.
Entre temps, j'en ai démarré une autre, avec laquelle je rencontre un nouveau problème. J'avais posté un nouveau sujet ne retrouvant pas celui-ci. Accepteriez-vous de jeter un oeil?
http://www.commentcamarche.net/forum/affich-28409890-erreur-sur-seleection-de-plage-de-cellules -
coucou,
il faut que tu inverses :
Set Automatisation = Application.Workbooks.Open("S:\AD Conseil\Fonds\Automatisation.xlsm", , True)
Set Carnetdebord = ThisWorkbook
car automatisation est alors = Carnetdebord.
Il faut que tu écrives :
Set Carnetdebord = ThisWorkbook
Set Automatisation = Application.Workbooks.Open("S:\AD Conseil\Fonds\Automatisation.xlsm", , True)
et je pense que ca devrait mieux fonctionner-
ModérateurBonjour Melanie,
As tu testé tes propos?
A mon avis, sans tester, le ThisWorkbook est et restera le classeur contenant la macro. C'est justement ce qui fait la différence entre ThisWorkbook et ActiveWorkbook...
Par contre, la boucle n'incrémente rien.
Remplacer :datedemodif = Automatisation.Sheets("Fonds").Range("E1").Value Automatisation.Sheets("Fonds").Activate For Ligne = 1 To 300 If datedemodif >= Now + 90 Then EntireRow.Copy Workbooks("Carnetdebord").Sheets("Import").Select Ligne = Sheets("Import").Range("A3").End(xlDown).Row + 1 ActiveSheet.Paste End If Next
par :With Automatisation.Sheets("Fonds") For Ligne = 1 To 300 datedemodif = .Range("E" & Ligne).Value If datedemodif >= Now + 90 Then EntireRow.Copy Workbooks("Carnetdebord").Sheets("Import").Range("A3").End(xlDown).Row + 1 End If Next End With
ou quelque chose dans le genre.
Je te laisse gérer ce sujet.
A+ -
-
ModérateurEt pourtant, je viens de lancer cette macro sur un de mes classeurs et .... cela fonctionne bien comme convenu. Le classeur contenant la macro reste le ThisWorkbook.
Sub test() Dim Automatisation As Workbook, Carnetdebord As Workbook 'A ADAPTER Set Automatisation = Application.Workbooks.Open("F:\Mes documents\TRAVAIL\bureau 2013\Liste téléphonique.xlsx", , True) Set Carnetdebord = ThisWorkbook MsgBox Automatisation.Name MsgBox Carnetdebord.Name End Sub
A voir en complément
remarque : rien n'empêche d'inverser les deux lignes, mais dans ce cas précis cela ne changera rien.
-
