Une macro par mois

En fait si possible un code vba s'il vous plait.

Bonjour,

C'est probablement possible, mais avec aussi peu d'informations, on ne peut guère te répondre précisément...

m@rina

Sub Enregistrement()

Dim balise As Boolean
Dim nbre As Integer, nbre2 As Integer, j As Integer, K As Integer, reponse As Integer
Dim wsEDM As Worksheet, wsSF As Worksheet, wsDM As Worksheet, wsLF As Worksheet, wsEM As Worksheet
Dim liste As Range
Dim valeur As Variant

Set wsEM = Workbooks("Enregistrement du mois").Worksheets("feuil2")
Set wsSF = Workbooks("Liste fournisseurs_test mdb").Worksheets("Feuil2")
Set wsEDM = ThisWorkbook.Worksheets("Enregistrement_du_mois")
Set wsDM = ThisWorkbook.Worksheets("Dernier Mois")
Set wsLF = ThisWorkbook.Worksheets("Liste fournisseur")

wsEDM.Cells.ClearContents
wsDM.Activate
Cells.Select
Range("K1").Activate
Selection.Copy
wsEDM.Activate
Range("A1").Select
ActiveSheet.Paste

'nbre = wsF.Cells(Rows.Count, 2).End(xlUp).Row - 1
'nbre2 = wsSF.Cells(Rows.Count, 1).End(xlUp).Row - 1
'
'For i = 1 To nbre2
' balise = False
' For j = 1 To nbre
' If wsSF.Cells(i + 1, 1).Value = wsF.Cells(j + 1, 2).Value Then balise = True
' Next j
'Next i

Application.ScreenUpdating = False

'Calcul du nombre de fournisseurs
nbre = wsLF.Cells(Rows.Count, 2).End(xlUp).Row - 1
Set liste = wsLF.Cells(2, 2).Resize(nbre, 3)

'Création du nom de la plage de cellule des fournisseurs
ThisWorkbook.Names.Add Name:="liste", RefersToR1C1:=liste

'Calcul du nombre de cadence du mois
nbre = wsEDM.Cells(Rows.Count, 1).End(xlUp).Row - 1

'''''Filtre fournisseurs'''''
'Calcul intermédiaire des valeurs de RechercheV
wsEDM.Cells(2, 17).Resize(nbre, 1).FormulaR1C1 = "=VLOOKUP(RC[-15],liste,1,0)"

'Tri des cadences en fonction du résultat de la RechercheV
wsEDM.Cells(2, 1).Resize(nbre, 17).Sort Key1:=Range("Q2"), Order1:=xlAscending

'Calcul du nombre de fournisseurs hors contexte
nbre2 = WorksheetFunction.CountIf(wsEDM.Cells(2, 17).Resize(nbre, 1), "=#N/A")

'Suppression des cadences hors contexte
wsEDM.Cells(nbre - nbre2 + 2, 1).Resize(nbre2, 19).Delete Shift:=xlUp

'Suppression de la colonne des RechercheV
wsEDM.Columns(17).Delete

'stockage du nombre de cadence dans la variable nbre
nbre = nbre2

'Création de la colonne "Code Unique" et concaténation des codes
wsEDM.Columns(17).Insert Shift:=xlToRight
wsEDM.Cells(1, 17).Value = "Code Unique"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=CONCATENER(D2;E2;F2)"
Range("Q2").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-11])"
Columns("Q:Q").Select
Selection.NumberFormat = "General"
Range("Q2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-11])"
Range("Q2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-6

'tri des données par ordre décroissant de date de réception
wsEDM.Cells(2, 1).Resize(nbre, 17).Sort Key1:=Range("Q2"), Order1:=xlDescending

'Calcul intermédiaire des valeurs de RechercheV
wsEDM.Cells(2, 18).Resize(nbre, 1).FormulaR1C1 = "=VLOOKUP(RC[-16],liste,3,0)"

wsEDM.Cells(2, 19).Resize(nbre, 1).FormulaR1C1 = "month(RC[-11])"

'Tri des cadences en fonction du résultat de la RechercheV
wsEDM.Cells(2, 1).Resize(nbre, 18).Sort Key1:=Range("R2"), Order1:=xlAscending

'Suppression des cadences hors contexte
nbre2 = WorksheetFunction.CountIf(wsEDM.Cells(2, 18).Resize(nbre, 1), "=#N/A")
wsEDM.Cells(nbre - nbre2 + 2, 1).Resize(nbre, 19).Delete Shift:=xlUp

End Sub

Ce code tourne une fois par mois donc le 1er jour qu'il sera lancé sera le 03/06, la seconde fois est le mois d'aprés et ainsi de suite