seclection date a partir de date d'aujourd'hui maccro

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion rak
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

rak

Guest
bonjour
j'aimerai que cette opreration s'effectue automatiquement en prenant en compte les date de la semaine dernieres
voila le script que j'obtient apres avoir effectuer le filtre test Macro
'
Macro enregistrée le 29/05/2009 par RESA3
'

'
Selection.AutoFilter Field:=4, Criteria1:=">=20090511", Operator:=xlAnd, _
Criteria2:="<=20090516"
End Sub

merci beaucoup
 
Trier par date Trier par votes
Re : seclection date a partir de date d'aujourd'hui maccro

Bonjour rak,

à tester :

Code: 
Dim Deb As String, Fin As String
Deb = Format(Date - 6 - Weekday(Date, vbMonday), "YYYYMMDD")
Fin = Format(Date - 1 - Weekday(Date, vbMonday), "YYYYMMDD")
Selection.AutoFilter Field:=4, Criteria1:=">=" & Deb, Operator:=xlAnd, _
Criteria2:="<=" & Fin
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

merci beaucoup😱😱 tototiti2008 je te felicite😀😀😀 car ca marche nickel et jaimerais bien avoir des explications

merci beaucoup 😀🙂🙂
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

Re,

quelques explications :
Date renvoie la date du jour
Weekday(Date, vbMonday), renvoir le numéro du jour de la semaine (lundi = 1, dimanche = 7)
Format permet de renvoyer les dates sous le format AAAAMMJJ

exemple : on est vendredi 29/5
pour aujourd'hui, weekday = 5
à la date d'aujourd'hui, on retranche 6+5 = 11 jours donc on se retrouve le 18/5 donc bien le lundi de la semaine dernière.
à la date d'aujourd'hui, on retranche 1+5 = 6 jours donc on se retrouve le 23/5 donc bien le samedi de la semaine dernière.
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

bonjour et merci pour ton explication c sympas de repondre rapidement mais je voudrait avoir une aide sur ce script 'jaimerai renommer le nom de la feuille automatiquement avec le nom de la feuille precedement enregistrer +1


exemple la semaine derniere s18 la semaine prochaine s18+1 =s19
comment faire
Sub test3()
'
' test3 Macro
' Macro enregistrée le 29/05/2009 par RESA3
'

'
Sheets("feuille1").Select
Sheets("feuille1").Name = "s22"
Range("J10112").Select
End Sub
merci beaucoup pour ton aide
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

Bonjour Rak, tototiti2008,

Une modif dans ton code
rak à dit:
Sub test3()
'
' test3 Macro
' Macro enregistrée le 29/05/2009 par RESA3
'
Code: 
'    Nosemaine= sheets("tafeuille").range("Ta cellule")
    Sheets("feuille1").Select
    Sheets("feuille1").Name = nosemaine+1
    Range("J10112").Select
End Sub
merci beaucoup pour ton aide
Cliquez pour agrandir...

ca devrait régler ton soucis

Edit : Si c'est suivant la dernière feuille +1 alors mettre sheets.count+1 et virer nosemaine 🙂
A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

re et encore merci de me repondre aussi rapidement
je veut renommer la nouvelle feuille a partir des feuilles anterieurs +1 de la derniere feuille existante
expl derniere feuille cree s18 nouvelle feuille s18+1 = s19

merci
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

ok desole tototiti ton bouton fonctionne tres bien comme tjrs mais jaimerai a jouter ce script a une autre macro qui celle ci ouvre une nouvelle feuille jaimerai donc que renomer la fauille sans utiliser le bouton je voudrais que cela ce deroule automatiquement est ce possible ?

merci encore pour m'avoir repondu aussi rapidement
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

voici ce que j'ai effectuer mais cela ne marche pas

' Macro1 Macro
' Macro enregistrée le 28/05/2009 par RESA3
'
Sub AjouteFeuille()
Dim Wks As Worksheet, numsem As Long
numsem = 0
For Each Wks In ThisWorkbook.Worksheets
If UCase(Wks.Name) Like "S*" And IsNumeric(Right(Wks.Name, Len(Wks.Name) - 1)) Then
If CLng(Right(Wks.Name, Len(Wks.Name) - 1)) > numsem Then numsem = CLng(Right(Wks.Name, Len(Wks.Name) - 1))
End If
Next Wks
ThisWorkbook.Worksheets.Add after:=Sheets(Sheets.Count)
ThisWorkbook.ActiveSheet.Name = "s" & numsem + 1
End Sub

'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\stat\stat05.mdb;Mode=Share Deny Write;Extended Propert" _
, _
"ies="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB😀atabase Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:" _
, _
"Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password" _
, _
"="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB😀on't Copy Locale on Compact=False;Jet OLE" _
, "DB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("inscription")
.Name = "stat05"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "D:\stat\stat05.mdb"
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft

Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft

Rows("1:1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=13, Criteria1:="A"

Range("N12499").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-12497]C:R[-1]C)"
Range("N12499").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End Sub


merci de bein vouloir m'aider
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

Re,

essaye en supprimant les lignes en rouge :

Code: 
Sub Macro1()
' Macro1 Macro
' Macro enregistrée le 28/05/2009 par RESA3
'
[COLOR=red]Sub AjouteFeuille()
[/COLOR]Dim Wks As Worksheet, numsem As Long
numsem = 0
For Each Wks In ThisWorkbook.Worksheets
If UCase(Wks.Name) Like "S*" And IsNumeric(Right(Wks.Name, Len(Wks.Name) - 1)) Then
If CLng(Right(Wks.Name, Len(Wks.Name) - 1)) > numsem Then numsem = CLng(Right(Wks.Name, Len(Wks.Name) - 1))
End If
Next Wks
ThisWorkbook.Worksheets.Add after:=Sheets(Sheets.Count)
ThisWorkbook.ActiveSheet.Name = "s" & numsem + 1
[COLOR=red]End Sub
[/COLOR]
'
[COLOR=red]ActiveWorkbook.Worksheets.Add
[/COLOR]With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=D:\stat\stat05.mdb;Mode=Share Deny Write;Extended Propert" _
, _
"ies="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:" _
, _
"Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password" _
, _
"="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLE" _
, "DB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("inscription")
.Name = "stat05"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "D:\stat\stat05.mdb"
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft

Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft

Rows("1:1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=13, Criteria1:="A"

Range("N12499").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-12497]C:R[-1]C)"
Range("N12499").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End Sub
 
Vote positif 0 Vote négatif
Re : seclection date a partir de date d'aujourd'hui maccro

bonjour tototiti2008
merci de ta reponse mais cela ne marche pas .une fois lancée la macro m'indique erreur de syntaxe

Sub Macro1()
' Macro1 Macro
' Macro enregistrée le 28/05/2009 par RESA3
'

Dim Wks As Worksheet, numsem As Long
numsem = 0
For Each Wks In ThisWorkbook.Worksheets
If UCase(Wks.Name) Like "S*" And IsNumeric(Right(Wks.Name, Len(Wks.Name) - 1)) Then
If CLng(Right(Wks.Name, Len(Wks.Name) - 1)) > numsem Then numsem = CLng(Right(Wks.Name, Len(Wks.Name) - 1))
End If
Next Wks
ThisWorkbook.Worksheets.Add after:=Sheets(Sheets.Count)
ThisWorkbook.ActiveSheet.Name = "s" & numsem + 1
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=D:\stat\stat05.mdb;Mode=Share Deny Write;Extended Propert" _
, _
"ies="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB😀atabase Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:" _
, _
"Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password" _
, _
"="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB😀on't Copy Locale on Compact=False;Jet OLE" _
, "DB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("inscription")
.Name = "stat05"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "D:\stat\stat05.mdb"
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft

Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft

Rows("1:1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=13, Criteria1:="A"

Range("N12499").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-12497]C:R[-1]C)"
Range("N12499").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End Sub
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

E
  • Résolu(e)
XL 2016 filtrer sous condition colonne date trimestriellement en vba
Réponses
7
Affichages
899
Compte Supprimé 979
C
M
  • Question Question
Microsoft 365 Macro filtre pour sélectionner les dates portant sur les 2 mois à venir à partir de la date du jour
Réponses
2
Affichages
1 K
michel.dupont
M
C
  • Question Question
XL 2019 Filtrage de données en VBA
Réponses
11
Affichages
2 K
Phil69970
Phil69970
V
  • Résolu(e)
Microsoft 365 VBA Excel : Filtres au-delà de 2 critères, quelle(s) solution(s) svp ?
Réponses
11
Affichages
2 K
VirginieG
V
J
  • Résolu(e)
Microsoft 365 Filtre fourchette de dates
Réponses
8
Affichages
2 K
job75
job75
F
  • Question Question
XL 2016 Code VBA EXTRACTION A PARTIR DUNE DATE ET COPIE ONGLET
Réponses
1
Affichages
1 K
herve62
herve62
F
  • Question Question
Macro Intervalle de date et heure qui ne fonctionne pas
Réponses
2
Affichages
1 K
F2T
F
M
  • Question Question
VBA insérer la commande date dans un autofilter
Réponses
8
Affichages
2 K
michel90
M
M
  • Question Question
filtre automatique par rapport à une date
Réponses
2
Affichages
1 K
michel90
M
S
  • Question Question
XL 2010 Macro sur date
Réponses
1
Affichages
734
jecherche
jecherche
A
  • Question Question
XL 2010 [Résolu] Créer un filtre date basé sur la valeur d'une cellule
Réponses
12
Affichages
2 K
arochab
A
A
  • Question Question
XL 2010 VBA coller ligne en fonction de la ligne du dessous
Réponses
5
Affichages
1 K
arochab
A
B
  • Question Question
Macro Excel - Filtre Antérieur à la date du jour
Réponses
3
Affichages
3 K
Staple1600
Staple1600
S
  • Question Question
Macro à partir de la valeur d'une liste pour ensuite filtrer
Réponses
5
Affichages
2 K
syl20du62
S
Y
  • Question Question
Recherche multicritères VBA
Réponses
8
Affichages
3 K
Ynwa_57
Y
B
  • Question Question
MACRO Recap de donné sur un tableau
Réponses
1
Affichages
902
boubou95
B
M
  • Question Question
Erreur macro avec filtre par date
Réponses
13
Affichages
2 K
martial58
M
C
  • Question Question
mettre en place un message d'erreur dans le cas d'une création de feuille.
Réponses
1
Affichages
1 K
ERIC S
ERIC S
L
  • Question Question
Concaténation pied de page vba excel
Réponses
3
Affichages
1 K
Pierrot93
Pierrot93
R
  • Question Question
Format date dans Autofilter
Réponses
2
Affichages
1 K
roulax
R
Retour