Bonjour le Forum
La macro que j'utilise me sert à créer des nouveaux classeurs en fonction d'une donnée en colonne A, cela fonctionne très bien, mais je ne garde pas la mise en forme du tableau d'origine;
Joint un fichier pour l'exemple et joint le code.
Sub Macro1Onglet()
Dim dl As Long
Dim pl As Range
Dim d As Object
Dim cel As Range
Dim tp As Variant
Dim i As Integer
Dim o As Object
With Sheets("Eclairage normal")
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set pl = .Range("A1:A" & dl)
End With
Set d = CreateObject("Scripting.Dictionary")
For Each cel In pl
d(cel.Value) = ""
Next cel
tp = d.keys
For i = 0 To UBound(tp)
On Error Resume Next
Set o = Sheets(CStr(tp(i)))
If Err <> 0 Then
Err = 0
Sheets.Add Before:=Sheets(1)
Set o = ActiveSheet
o.Name = CStr(tp(i))
End If
On Error GoTo 0
o.Cells.Clear
Sheets("Eclairage normal").Range("A1").AutoFilter
Sheets("Eclairage normal").Range("A1").AutoFilter Field:=1, Criteria1:=tp(i)
pl.Offset(0, 1).Resize(pl.Rows.Count, 20).SpecialCells(xlCellTypeVisible).Copy o.Range("A1")
Sheets("Eclairage normal").Range("A1").AutoFilter
Next i
End Sub
Bonjour Dranreb
j'ai rajouté dans la boucle et je garde bien la mise en forme hauteur et largeur, mais je voudrais garder le mode tableau.
Tu crois que c'est possible
Merci
Voici où je l'ai mis
With Sheets("Eclairage normal")
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set pl = .Range("A1:A" & dl)
End With
Set d = CreateObject("Scripting.Dictionary")
For Each cel In pl
d(cel.Value) = ""
Next cel
tp = d.keys
For i = 0 To UBound(tp)
On Error Resume Next
Set o = Sheets(CStr(tp(i)))
If Err <> 0 Then
Err = 0
Sheets.Add Before:=Sheets(1)
Set o = ActiveSheet
o.Name = CStr(tp(i))
End If
On Error GoTo 0
o.Cells.Clear
Sheets("Eclairage normal").Range("A1").AutoFilter
Sheets("Eclairage normal").Range("A1").AutoFilter Field:=1, Criteria1:=tp(i)
pl.Offset(0, 1).Resize(pl.Rows.Count, 20).SpecialCells(xlCellTypeVisible).Copy o.Range("A1")
Sheets("Eclairage normal").Range("A1").AutoFilter
Next i
With o.ListObjects.Add(xlSrcRange, o.UsedRange, , xlYes)
.Name = "Tab" & Replace(o.Name, " ", "")
.TableStyle = "TableStyleMedium6"
End With
End Sub
Mis au bonne endroit nickel
Encore merci
Je me permet de te demander si c'est possible, voici le fichier que je travaille.
J'ai 3 onglets différents qui ont une valeur commune la colonne A
J'ai trouvé un code que j'ai adapté, d'abords je crée des onglets avec le code que tu viens de m'adapter et après avec le deuxième code je crée des fichiers avec les onglets différents.
Je cherche sur la toile mais je n'ai pas encore trouvé, je bloque mon but et de créer des fichiers avec les 3 onglets par site (colonne A).
Dans ma méthode cela crée 200 onglets fois 3 donc 600 fichiers que je doit retravailler en déplacent les onglets pour arriver à mon résultat fichier "Site 1".
J'ai mis les fichiers qui expliqueront surement mieux que moi
Merci
Bobjazz