Microsoft 365 Problème pour répartir des données mensuellement

[Karim48]

Bonjour les amis,

Me voilà à nouveau (et je ne vous remercierai jamais assez pour votre aide). Me voila avec une VBA créée pour répartir des données mensuellement dans un onglet différent à chaque fois.

Mon premier problème est que j'aimerais que les feuilles vides cessent d'apparaitre à chaque fois que je lance la macro.
Mon second problème concerne la mise en forme du tableau créé. J'aimerais que les colonnes s'ajustent au contenu du texte d'une part et d'autre part que le tableau nouvellement créé ait des bordures également ajustées (cadre faisant le contour global ou une ligne le fermant à la dernière donnée).

Quelqu'un pourrait m'aider? Merci d'avance.

Karim

 

[Karim48]

voici le code en question:

Sub Extrait2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set F = Sheets("Feuil1")
Set d = CreateObject("scripting.dictionary")
Tbl = F.Range("b2:b" & F.[b65000].End(xlUp).Row).Value
For i = 1 To UBound(Tbl)
temp = Format(Tbl(i, 1), "mmmm yyyy")
d(temp) = ""
Next i
[Z2].Formula = "=and(MONTH(b2)=$aa$1,year(b2)=$ab$1)"
'[ad2].Resize(d.Count) = Application.Transpose(d.keys)
For Each c In d.keys
On Error Resume Next: Sheets(c).Delete: On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' cr?ation
If c <> vbNullString Then
ActiveSheet.Name = c
'-- extraction
F.[aa1] = Month("01/" & c): F.[ab1] = Right(c, 4)
F.[A1:g10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=F.[z1:z2], CopyToRange:=[A1]
End If
Next c
End Sub

 

[Karim48]

Up