Sub test()
'ecrire le mois dans la colonne P
'faire un filtre sur la colonne
'transcrire la colonne dans le bon mois
Sheets("Feuil1").Select
RowCount = Cells(Cells.Rows.Count, "b").End(xlUp).Row
Range("b2").Select
For i = 2 To RowCount
Range("b" & i).Select
cval = ActiveCell.Value
cval2 = Mid(cval, 4, 2)
Select Case cval2
Case 1
wmonth = "Jan"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 2
wmonth = "Feb"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 3
wmonth = "Mar"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 4
wmonth = "Apr"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 5
wmonth = "May"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 6
wmonth = "Jun"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 7
wmonth = "Jul"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 8
wmonth = "Aug"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 9
wmonth = "Sep"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 10
wmonth = "Oct"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 11
wmonth = "Nov"
Range("P" & i).Select
ActiveCell.Value = wmonth
Case 12
wmonth = "Dec"
Range("P" & i).Select
ActiveCell.Value = wmonth
End Select
Next
'faire un filtre sur la colonne P
myarray = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
For j = 0 To 11
Range("A1:P" & RowCount).Select
Selection.AutoFilter Field:=16, Criteria1:=myarray(j)
Rowcount1 = Cells(Cells.Rows.Count, "b").End(xlUp).Row
If Rowcount1 = 1 Then
'GoTo line1
End If
'transcrire la colonne dans le bon mois
'Trouve la bonne colonne
Range("A1").Select
With ActiveSheet
valu = myarray(j)
valu = valu & "*"
Set rFound = .UsedRange.Find(valu, .Cells(1, 1), xlValues, xlWhole, , , False)
Application.Goto rFound, True
adr = ActiveCell.Address(rowabsolute, columnabsolute)
adr = Left(adr, 1)
End With
With ActiveSheet.AutoFilter.Range
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 1).Resize(rng.Rows.Count).Copy _
Destination:=Worksheets("Feuil2").Range(adr & "2")
ActiveSheet.ShowAllData
End With
Next
'copy de feuil2 a feuil1
Sheets("Feuil2").Select
ActiveSheet.UsedRange.Copy _
Destination:=Worksheets("Feuil1").Range("D2")
'nettoyage
Sheets("Feuil2").Select
ActiveSheet.UsedRange.ClearContents
Range("A1").Select
Sheets("Feuil1").Select
Selection.AutoFilter
Columns("P:P").Select
Selection.Delete Shift:=xlToLeft
Range("D2").Select
End Sub