Rapport de message :*
 

AIDE EXCEL VBA COPIER COLLER FEUILLE COMPLÈTE AVEC GRAPH

Titre du sujet : AIDE EXCEL VBA COPIER COLLER FEUILLE COMPLÈTE AVEC GRAPH
par ritchi3131 le 13/10/2017 16:23:37

Bonjour

Je travaille beaucoup avec les formules mais par contre je ne connais pas le VBA . On m'a fait un code que je suis arrivé à adapter sur un autre travail, mais la, je bloque. Le code permet de copier une feuille Excel donc avec les tableaux et les mises en formes , sans les formules (pour qu'ils ne se mettent pas à jour) vers une nouvelle dont on à choisit le nom dans une liste et cela fonctionne avec une fenêtre de choix .. Mais dans cette feuille, j'ai des graphiques présents et j'aimerai qu'ils soient copiées, ce qui n'est pas le cas actuellement.. La feuille source s'appelle "Reporting"

la partie qui permet de copier (si j'ai bien tout saisi) est la suivante :

' Copie de la feuille "Reporting" sans les formules pour éviter que les données se mettent à jours
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Reporting").Cells.Copy
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(Sheets.Count).Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
[A1].Select

/////////////////////////////////////////////////////////////////////////////////


Le code complet est ci dessous :





Private Sub annuler_Click()
Unload Me
End Sub

Private Sub ComboBox1_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub OK_Click()
If ComboBox1 = "" Then
MsgBox ("VEUILLEZ SELECTIONNER LA SEMAINE A CREER")
Exit Sub
End If
For I = 1 To Sheets.Count
If UCase(Left(Sheets(I).Name, Len(ComboBox1))) = UCase(ComboBox1) Then
MsgBox ("La feuille " & UCase(ComboBox1) & " existe déjà, si vous désirez regénérer une feuille de données veuillez la supprimer avant toute action")
Exit Sub
End If
Next I
' Copie de la feuille "Reporting" sans les formules pour éviter que les données se mettent à jours
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Reporting").Cells.Copy
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(Sheets.Count).Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
[A1].Select
Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub UserForm_Initialize()
ComboBox1.AddItem "Semaine42"
ComboBox1.AddItem "Semaine43"
ComboBox1.AddItem "Semaine44"
ComboBox1.AddItem "Semaine45"
ComboBox1.AddItem "Semaine46"
ComboBox1.AddItem "Semaine47"
ComboBox1.AddItem "Semaine48"
ComboBox1.AddItem "Semaine49"
ComboBox1.AddItem "Semaine50"
ComboBox1.AddItem "Semaine51"
ComboBox1.AddItem "Semaine52"
End Sub


///////////////////////////////////////////////////////


Merci les gens d'avance !