Sub moisAnnee()
Dim datas, dict, lig As Long, k
datas = [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1).Value
Set dict = CreateObject("Scripting.Dictionary")
For lig = 1 To UBound(datas)
If IsDate(datas(lig, 1)) Then
k = Year(datas(lig, 1)) & "-" & Format(Month(datas(lig, 1)), "00")
dict(k) = k
End If
Next lig
For Each k In dict.keys
Debug.Print k
Next k
Set dict = Nothing
End Sub
k = Year(datas(lig, 1)) & "-" & Format(Month(datas(lig, 1)), "00")
Sub Ventiler()
Dim Ddate As Object, base(), i As Long, cle, oSheet as worksheet
Set oSheet = ThisWorkbook.Worksheets("export")
Set Ddate = CreateObject("Scripting.Dictionary")
dl = Range("a" & Rows.Count).End(xlUp).Row
base = oSheet.Range("A2:A" & dl).Value2
For i = LBound(base, 1) To UBound(base, 1)
If Not Ddate.exists(Month(base(i, 1)) & "|" & Year(base(i, 1))) Then Ddate(Month(base(i, 1)) & "|" & Year(base(i, 1))) = ""
Next i
For Each cle In Ddate.keys
Debug.Print cle
Next cle
End Sub
Option Explicit
Dim Ws As Object
Dim dL As Long
Dim ShtName As String
Sub Ventiler()
Dim Ddate As Object, base, i As Long, cle, oSheet As Worksheet
Application.ScreenUpdating = False
Set oSheet = ThisWorkbook.Worksheets("export")
Set Ddate = CreateObject("Scripting.Dictionary")
With oSheet
dL = .Range("a" & .Rows.Count).End(xlUp).Row
base = .Range("A2:A" & dL).Value2
End With
For i = LBound(base, 1) To UBound(base, 1)
If Not Ddate.exists(Month(base(i, 1)) & "|" & Year(base(i, 1))) Then
Ddate(Month(base(i, 1)) & "|" & Year(base(i, 1))) = ""
ShtName = Format(base(i, 1), "mm-yyyy")
Set Ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
With Ws
.Name = ShtName
End With
End If
Next i
Set base = Nothing
Application.ScreenUpdating = True
End Sub
ShtName = Format(base(i, 1), "mmmm yyyy")
Sub GetUniques()
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
'Ajout d'une colonne transitoire à droite du tableau ici B
[B2].FormulaR1C1 = _
"=CHOOSE(MONTH([@[Date commande]]),""Janvier "",""Février "",""Mars "",""Avril "",""Mai "",""Juin "",""Juillet "",""Août "",""Septembre "",""Octobre "",""Novembre "", ""Décembre "") & YEAR([@[Date commande]])"
c = Range("b2:b" & lr)
For i = 1 To UBound(c, 1)
d(c(i, 1)) = 1
Next i
'transfert des dates sans doublons dans la colonne E à modifier selon le besoin
Range("e2").Resize(d.Count) = Application.Transpose(d.keys)
'Suppression de la colonne transitoire ici B à modifier
Columns("B:B").Delete Shift:=xlToLeft
'CREATION DES FEUILLES
'd2 à changer par l'adresse de la première ligne contenant les dates
datas = [d2].Resize(Cells(Rows.Count, 4).End(xlUp).Row - 1).Value
Set dict = CreateObject("Scripting.Dictionary")
For lig = LBound(datas) To UBound(datas)
ShtName = datas(lig, 1)
Set Ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
With Ws
.Name = ShtName
End With
Next lig
End Sub
ShtName = Format(base(i, 1), "mmmm yyyy")
D'après ce que j'ai compris la feuille qui contient les données évolue, donc les feuilles sont supprimées avant de les recréer et y transférer les données.une question tu ne crées ces feuilles et ne transfères les données qu'une seule fois ?
Sub Transfert()
For i = 2 To Range("a" & Rows.Count).End(xlUp).Row
K = Format(Month(Cells(i, 1)), "00")
L = Year(Cells(i, 1))
KL = K & "-" & L
Range("A" & i & ":L" & i).Copy
Sheets(KL).Activate
dL = Range("a" & Rows.Count).End(xlUp).Row + 1
Range("A" & dL).Select
ActiveSheet.Paste
Sheets("export").Activate
Next
End Sub
Sub Ventiler() 'code de ChTi160
Dim Ddate As Object, base, i As Long, cle, oSheet As Worksheet
Application.ScreenUpdating = False
'd'ici
Set Ddate = CreateObject("Scripting.Dictionary")
'supprimer feuilles
For Each oSheet In Sheets
If LCase(oSheet.Name) <> "export" Then
Application.DisplayAlerts = False
oSheet.Delete
Application.DisplayAlerts = True
End If
Next
Set oSheet = ThisWorkbook.Worksheets("export") ' à La
With oSheet
dL = .Range("a" & .Rows.Count).End(xlUp).Row
base = .Range("A2:L" & dL).Value2 '**données de colA à colL
End With