Bonjour à tous voila avec mes petite compétence j'ai réussis à créer mes macro une pour le matin une pour l apres midi et une pour la nuit/
mais ma question est celle ci puis je avec mes 3 macro en creer 1 seul macro pouvez vous m aider svp merci
mais ma question est celle ci puis je avec mes 3 macro en creer 1 seul macro pouvez vous m aider svp merci
Code:
Sub mAJ()
Dim start As Single
'en début de la macro
start = Timer
Ajout_Auto_M
Ajout_Auto_AP
Ajout_Auto_N
Retrait_Auto_M
Retrait_Auto_AP
Retrait_Auto_N
'avant end sub
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub
'FListe.Cells(i, x).Delete Shift:=xlUp
'FListe.Cells(a + 29, x).Insert Shift:=xlDown
'FListe.Cells(i, x).Interior.ColorIndex = 6
'If FListe.Cells(i, x).Interior.ColorIndex = 6 Then
Sub Ajout_Auto_M()
Dim c As Range, s As Range, d As Range, TaValeur As String, TaValeur2 As String, FListe As Worksheet, FParametre As Worksheet, FDispo As Worksheet
Set FListe = Worksheets("Liste")
Set FDispo = Worksheets("Dispo")
Set FParametre = Worksheets("Parametre")
Application.ScreenUpdating = False
Application.EnableEvents = False
a = 4
b = 2
For v = 1 To 31
For x = 1 To 4
For i = 3 To 34
DL = FListe.Cells(a + 30, x).End(xlUp).Row + 1
TaValeur = FDispo.Cells(i, b).Value
Set c = FListe.Range(FListe.Cells(a, x), FListe.Cells(a + 30, x)).Find(TaValeur, FListe.Cells(a, x))
If Not c Is Nothing Then
Set c = Nothing
Else
Set s = FParametre.Range(FParametre.Cells(2, 9 + x), FParametre.Cells(200, 9 + x)).Find(TaValeur, FParametre.Cells(2, 9 + x))
If Not s Is Nothing Then
FListe.Cells(DL, x) = TaValeur
Set s = Nothing
Else
End If
End If
Next i
Next x
a = a + 34
b = b + 3
Next v
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub Retrait_Auto_M()
Dim c As Range, s As Range, d As Range, TaValeur As String, TaValeur2 As String, FListe As Worksheet, FDispo As Worksheet, FParametre As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
a = 4
b = 2
For v = 1 To 31
Set FListe = Worksheets("Liste")
Set FDispo = Worksheets("Dispo")
For x = 1 To 4
For i = a + 30 To a Step -1
TaValeur = FListe.Cells(i, x).Value
Set c = FDispo.Range(FDispo.Cells(3, b), FDispo.Cells(34, b)).Find(TaValeur, FDispo.Cells(3, b))
If c Is Nothing Then
FListe.Cells(i, x).Delete Shift:=xlUp
FListe.Cells(a + 29, x).Insert Shift:=xlDown
Set c = Nothing
Else
End If
Next i
Next x
a = a + 34
b = b + 3
Next v
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub Ajout_Auto_N()
Dim c As Range, s As Range, TaValeur As String, TaValeur2 As String, FListe As Worksheet, FParametre As Worksheet, FDispo As Worksheet
Set FListe = Worksheets("Liste")
Set FDispo = Worksheets("Dispo")
Set FParametre = Worksheets("Parametre")
Application.ScreenUpdating = False
Application.EnableEvents = False
a = 4
b = 4
d = 10
For v = 1 To 31
For x = 9 To 12
For i = 3 To 34
'DL2 = FParametre.Cells(200, d).End(xlUp).Row
DL = FListe.Cells(a + 30, x).End(xlUp).Row + 1
TaValeur = FDispo.Cells(i, b).Value
Set c = FListe.Range(FListe.Cells(a, x), FListe.Cells(a + 30, x)).Find(TaValeur, FListe.Cells(a, x))
If Not c Is Nothing Then
Set c = Nothing
Else
Set s = FParametre.Range(FParametre.Cells(2, 1 + x), FParametre.Cells(200, 1 + x)).Find(TaValeur, FParametre.Cells(2, 1 + x))
If Not s Is Nothing Then
FListe.Cells(DL, x) = TaValeur
Set s = Nothing
Else
End If
End If
Next i
Next x
a = a + 34
b = b + 3
d = d + 1
Next v
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub Ajout_Auto_AP()
Dim c As Range, s As Range, TaValeur As String, TaValeur2 As String, FListe As Worksheet, FParametre As Worksheet, FDispo As Worksheet
Set FListe = Worksheets("Liste")
Set FDispo = Worksheets("Dispo")
Set FParametre = Worksheets("Parametre")
Application.ScreenUpdating = False
Application.EnableEvents = False
a = 4
b = 3
d = 10
For v = 1 To 31
For x = 5 To 8
For i = 3 To 34
'DL2 = FParametre.Cells(200, d).End(xlUp).Row
DL = FListe.Cells(a + 30, x).End(xlUp).Row + 1
TaValeur = FDispo.Cells(i, b).Value
Set c = FListe.Range(FListe.Cells(a, x), FListe.Cells(a + 30, x)).Find(TaValeur, FListe.Cells(a, x))
If Not c Is Nothing Then
Set c = Nothing
Else
Set s = FParametre.Range(FParametre.Cells(2, 5 + x), FParametre.Cells(200, 5 + x)).Find(TaValeur, FParametre.Cells(2, 5 + x))
If Not s Is Nothing Then
FListe.Cells(DL, x) = TaValeur
Set s = Nothing
Else
End If
End If
Next i
Next x
a = a + 34
b = b + 3
d = d + 1
Next v
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub Retrait_Auto_AP()
Dim c As Range, s As Range, d As Range, TaValeur As String, TaValeur2 As String, FListe As Worksheet, FDispo As Worksheet, FParametre As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
a = 4
b = 3
For v = 1 To 31
Set FListe = Worksheets("Liste")
Set FDispo = Worksheets("Dispo")
For x = 5 To 8
For i = a + 30 To a Step -1
TaValeur = FListe.Cells(i, x).Value
Set c = FDispo.Range(FDispo.Cells(3, b), FDispo.Cells(34, b)).Find(TaValeur, FDispo.Cells(3, b))
If c Is Nothing Then
FListe.Cells(i, x).Delete Shift:=xlUp
FListe.Cells(a + 29, x).Insert Shift:=xlDown
Set c = Nothing
Else
End If
Next i
Next x
a = a + 34
b = b + 3
Next v
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub Retrait_Auto_N()
Dim c As Range, s As Range, d As Range, TaValeur As String, TaValeur2 As String, FListe As Worksheet, FDispo As Worksheet, FParametre As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
a = 4
b = 4
For v = 1 To 31
Set FListe = Worksheets("Liste")
Set FDispo = Worksheets("Dispo")
For x = 9 To 12
For i = a + 30 To a Step -1
TaValeur = FListe.Cells(i, x).Value
Set c = FDispo.Range(FDispo.Cells(3, b), FDispo.Cells(34, b)).Find(TaValeur, FDispo.Cells(3, b))
If c Is Nothing Then
FListe.Cells(i, x).Delete Shift:=xlUp
FListe.Cells(a + 29, x).Insert Shift:=xlDown
Set c = Nothing
Else
End If
Next i
Next x
a = a + 34
b = b + 3
Next v
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'FListe.Cells(i, x).Delete Shift:=xlUp
'FListe.Cells(a + 29, x).Insert Shift:=xlDown
'FListe.Cells(i, x).Interior.ColorIndex = 6
'If FListe.Cells(i, x).Interior.ColorIndex = 6 Then
