Bonjour,
Une petite idée ?
Merci
Essaye ceci :
Sub copy_paste()
Application.ScreenUpdating = False 'Désactive l'affichage en temps réel
Application.Calculation = xlCalculationManual 'Désactive le recalcul auto des formules Excel
Dim y As Integer, z As Integer, Lig As Integer
Dim Dest As Worksheet
Set Dest = Sheets("Echange standard")
Dest.Range("B8:M25").ClearContents
With Sheets("Dates envois réalisés (2)")
'Parcourir la liste des projets
For y = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
'Parcourir les mois (Planning préparation)
For z = 2 To 13
If Month(.Cells(y, 3)) = Month(Dest.Cells(6, z)) And Year(.Cells(y, 3)) = Year(Dest.Cells(6, z)) Then Dest.Cells(Dest.Cells(25, z).End(xlUp).Row + 1, z) = .Cells(y, 1)
Next z
'Parcourir les mois (Planning envoi)
For z = 2 To 24 Step 2
If Month(.Cells(y, 4)) = Month(Dest.Cells(29, z)) And Year(.Cells(y, 4)) = Year(Dest.Cells(29, z)) Then
Lig = Dest.Cells(100, z).End(xlUp).Row + 1 'Détermine l'indice de la première ligne vide du mois
Dest.Cells(Lig, z) = .Cells(y, 1) 'Report de la référence projet
Dest.Cells(Lig, z + 1) = .Cells(y, 2) 'Report de la date de début
End If
Next z
Next y
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Attention : la ligne contenant les dates dans chaque tableau de l'onglet "échange standard" ne doit pas changer !