Transfert ou Extration d'enregistrement a une date

Bonjour à Tous,

Passionné mais pas expert en VBA, je recherche une routine qui pourrait me transférer mes enregistrements dans une autre feuille de mon classeur ou encore mieux dans un autre dossier.

Voici les données concernées pour le transfert:

A2 = Date de Réception 01/09/21

D2 = Date de Cloture 22/09/21

Je souhaite transférer la ligne 2 (et d'autres), deux mois après la date de clôture 22/11/21

Peut être si cela est possible une variable qui me permettrait de jouer sur le temps.

Un grand merci pour votre aide

Je reste à votre disposition pour plus amples informations

cordialement, Thierry

Version : EXCEL 2010

Bonjour,

Une boîte de saisie s'ouvre pour y inscrire le nombre de mois après la date de clôture (par défaut: 2), la date ainsi obtenue est comparée avec la date du jour, il ne vous reste plus qu'à écrire le reste pour copier/coller la ligne sélectionnée.

nb_Mois = InputBox("Saisir le nombre de mois à ajouter à la date de clôture pour transférer la ligne", , 2) * 1
If Application.WorksheetFunction.EDate(Range("D2"), nb_Mois) >= Date Then
' A vous de compléter le code pour la copie de la ligne vers la feuille destination.
End If

Cdlt

Merci ARTURO83 pour cette réponse.

Mon objectif est plutôt d'automatiser et de faire en sorte que lorsque j'ouvre mon classeur une routine se mette en route pour scanner mon tableau et transferer les enregistrements => à 2 mois (En fonction de la variable indiquée dans une cellule)

Inputbox était effectivement interessante pour une situation manuelle.

Est ce que ci une cellule est utilisée pour donner le nbre de jours ou de mois cela peut se faire.

Merci pour l'aide que tu m'apportes.

Bonne journée, Thierry

Pour que la macro fonctionne à l'ouverture du classeur, il faut la mettre dans le module du classeur (Thisworkbook, Workbook_Open), comme ci-dessous:

Bien sûr il faut adapter la macro à vos besoins

Cdlt

Merci Arturo83,

Je vais maintenant mettre le peux de connaissance que je possede pour mettre en place ma boucle de transfert vers une nouvelle feuille si c plus facile ou un autre dossier.

Je tenais à vous remercier pour le soutien que vous m'apportez.

cdlt, Thierry

Bonjour,

Je manque de logique et je n'arrive pas à gerer la date de cloture du dossier avec la date de transfert.

merci pour votre aide

Cdlt Thierry

Private Sub Workbook_Open()

'=========================================================

'Attribution du nombre de jours pour la date de transfert

'=========================================================

nb_mois = Range("D3").Value 'D3 cellule Variable

If Application.WorksheetFunction.Edate(Range("N8"), nb_mois) >= Date Then

'===================================

'Selection de la Feuille de Données*

'===================================

Sheets("IP").Select

'==========================

'Déclaration des variables

'==========================

Dim TRFDate As Integer 'Date de Transfert

Dim NbrL As Long 'Nbre de lignes

Dim LigneActive As Long 'Ligne de repere pour transfere l'enregistrement

'==========================

'Affectation des Variables

'==========================

Set celluleTRFDate = Range("T8")

Set Edate = Feuil1.Range("B8", Feuil1.Range("B7").End(xlDown))

NbrL = Edate.Rows.Count

LigneActive = 0

'TRFDate.Value = Range("n8")

'========================================

'Insertion d'une nouvelle Feuille(Onglet)

'========================================

Sheets.Add

ActiveSheet.Name = "Archive IP Cloturées"

Feuil1.Range("B7").EntireRow.Copy ActiveCell

Range("B1").Select

'=========================================================

'On Boucle tant que l'on a des enregistrements = à TRFDate

'=========================================================

If TRFDate = Date Then

For Each Edate In Feuil1

'=======================

'On descend vers le bas

'=======================

LigneActive = LigneActive + 1

'===============================

'Recherche des date à transferer

'===============================

If Edate.Offset(0, 19).Value = Edate.Value Then

'===================================================================

'Si la Date en Colonne T est = à EDate on récupère l'enregistrement

'===================================================================

Edate.EntireRow.Copy ActiveCell

ActiveCell.Offset(1, 0).Select

End If

Next Edate

End If

'Ajustement des colonne de mon Tableau Archive

Range("B2").Select

ActiveCell.CurrentRegion.EntireColumn.AutoFit

End If

End Sub

*****************************************************

Apres mettre tiré les cheveux dans tous les sens, tourné les pages de mes bouquins sur les court VBA

J'arrive a rajouter un nouvel onglet "Archive IP Cloturées" mais sans obtenir la mise à jour sur les colonnes.

Mais le plus ennuyeux c'est que j'ai aucun enregistrement de transferés.

Merci, pour l'aide que vous m'apporterai.

Cdlt, Thierry

Bonjour,

- Dans votre code, n'y a t-il pas un "End if" en trop ? (le dernier).

D'après votre code, il y aurait 2 feuilles "Feuil1"; "IP" auxquelles vous ajoutez une 3ème feuille que vous nommez "Archive IP Cloturées".

Comme je n'ai pas votre fichier sous les yeux , je me pose des questions, Dans quelles feuilles sont les données; le nombre de mois (cellule D3) dans quelle feuille?

-Attention: "EDate" est déjà une fonction réservée au VBA, vous devez utiliser un autre terme.

Pour tester la date de transfert + nombre de mois, vous n'avez pas repris ma proposition:

If Application.WorksheetFunction.EDate(Range("D2"), Nb_mois) >= Date Then

CDlt

Bonjour, et merci pour votre gentillesse et rapidité à répondre à mon problème désorganisé.

=====================

Mon Projet est comme précisé ci dessous:

Dans mon classeur on y trouve 3 Onglets

1 Onglet nommé "IP" ou se trouve toutes les données saisies par l'utilisatrice

2 Onglet "Paramétrage"

3 Onglet "Archive I.P Clôturées" on doit y retrouver tous les enregistrements venant de la feuille "IP" correspondant à la date de transfert.

L'image écran que je vous ai mis sur le site correspond à la feuille principale (IP) (mais je pense que vous le saviez.)

J'ai modifié "EDate" par "TDATE" comme vous me le signalez dans votre message, et votre instruction que vous me conseillez d'utiliser se trouve tout au début de mon programme (certainement positionné au mauvais endroit)

Je pense qu'il y a beaucoup plus simple niveau développement VBA concernant le transfert de mes enregistrements.

Private Sub Workbook_Open()

'=========================================================
'Attribution du nombre de jours pour la date de transfert
'=========================================================

nb_mois = Range("D3").Value 'D3 cellule Variable se trouve dans la feuille IP

If Application.WorksheetFunction.Edate(Range("N13"), nb_mois) >= Date Then 'N13 = Date de Fin d'evaluation

'===================================
'Selection de la Feuille de Données*
'===================================

Sheets("IP").Select 'Feuille ou se trouve les données

'==========================
'Déclaration des variables
'==========================
Dim TRFDate As Integer 'Date de Transfert
Dim NbrL As Long 'Nbre de lignes
Dim LigneActive As Long 'Ligne de repere pour transfere l'enregistrement

'==========================
'Affectation des Variables
'==========================
Set celluleTRFDate = Range("T8")
Set Tdate = Feuil1.Range("B8", Feuil1.Range("B7").End(xlDown))
NbrL = Tdate.Rows.Count
LigneActive = 0

'========================================
'Insertion d'une nouvelle Feuille(Onglet)
'========================================
Sheets.Add
ActiveSheet.Name = "Archive I.P Cloturées"
Feuil3.Range("B3").EntireRow.Copy ActiveCell
Range("B4").Select
'=========================================================
'On Boucle tant que l'on a des enregistrements = à TRFDate
'=========================================================
If TRFDate = Date Then


For Each Tdate In Feuil1

'=======================
'On descend vers le bas
'=======================
LigneActive = LigneActive + 1

'===============================
'Recherche des date à transferer
'===============================
If Tdate.Offset(0, 19).Value = Tdate.Value Then

'===================================================================
'Si la Date en Colonne T est = à TDate on récupère l'enregistrement
'===================================================================
Tdate.EntireRow.Copy ActiveCell
ActiveCell.Offset(1, 0).Select

End If ' IF Tdate


Next Tdate

End If 'IF TRFDate

'Ajustement des colonne de mon Tableau Archive
Range("B2").Select
ActiveCell.CurrentRegion.EntireColumn.AutoFit

End If 'If Application ===> 1er IF

End Sub

********************************************************************

Un grand merci pour l'aide que vous m'apportez.

Cdlt, Thierry