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