Sub Macro2()
Dim Wkb As Workbook
Dim shDestination As Worksheet
Dim NomFeuille As String
If ActiveSheet.Name = "Achat" Then
Set Wkb = Workbooks("Archive Achat.xlsx")
ElseIf ActiveSheet.Name = "Vente" Then
Set Wkb = Workbooks("Archive Vente.xlsx")
Else
Exit Sub
End If
If Wkb Is Nothing Then Exit Sub
'ATTENTION il faut que le mois et l'année soient dans les mêmes cellule de chaque feuille
NomFeuille = Range("I13") & " " & Range("I14")
'La function GetWorkSheet créera la feuille au besoin
Set shDestination = GetWorkSheet(NomFeuille, Wkb, True)
If shDestination Is Nothing Then Exit Sub '
Range("A2:F42").Copy
With shDestination
.Cells(1, .UsedRange.Columns.Count).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
End Sub
Function GetWorkSheet(SheetName As String, Optional Wkb As Workbook = Nothing, Optional CreateIfNotExists As Boolean = False) As Worksheet
'Hasco
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook
On Error Resume Next
Set GetWorkSheet = Wkb.Sheets(SheetName)
If GetWorkSheet Is Nothing And CreateIfNotExists Then
Dim sh As Worksheet, i As Integer
With Wkb
Set sh = .Worksheets(1)
For i = 2 To .Sheets.Count
If IsDate(.Sheets(i).Name) And IsDate(sh.Name) Then
If CDate("1 " & SheetName) > CDate("1 " & sh.Name) And CDate("1 " & SheetName) < CDate("1 " & .Sheets(i).Name) Then Exit For
End If
Set sh = .Sheets(i)
Next
Set GetWorkSheet = .Sheets.Add(After:=sh)
GetWorkSheet.Name = SheetName
End With
End If
End Function