XL 2010 AIDE EXCEL VBA COPIER COLLER FEUILLE COMPLÈTE AVEC GRAPH

[richard31]

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 !

 

[youky(BJ)]

Bonjour,
je n'ai pas testé mais essayer comme ceci
Bruno

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").Copy
with Sheets(Sheets.Count)
.Select
.cells.value=.cells.value
.Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
.[A1].Select
end with
Application.ScreenUpdating = True
Unload Me
End Sub

 

[richard31]

Bonjour,
je n'ai pas testé mais essayer comme ceci
Bruno

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").Copy
with Sheets(Sheets.Count)
.Select
.cells.value=.cells.value
.Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
.[A1].Select
end with
Application.ScreenUpdating = True
Unload Me
End Sub

Bonjour

Cela ne fonctionne pas, copie sur une autre feuille, et me copie les formules des tableaux . je vais regarder de plus près mais merci

 

[Efgé]

Bonjour à tous

Dans le vide puisque sans fichier pour tester:

' Copie de la feuille "Reporting" sans les formules pour éviter que les données se mettent à jours
Application.ScreenUpdating = False
Sheets("Reporting").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
    .Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
    With .UsedRange
        .Value = .Value
    End With
End With
Application.ScreenUpdating = True

Cordialement

 

[richard31]

Bonjour à tous

Dans le vide puisque sans fichier pour tester:

' Copie de la feuille "Reporting" sans les formules pour éviter que les données se mettent à jours
Application.ScreenUpdating = False
Sheets("Reporting").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
    .Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
    With .UsedRange
        .Value = .Value
    End With
End With
Application.ScreenUpdating = True

Cordialement

je colle le fichier juste avec la feuille qui m intéresse. Donc le code déjà présent fonctionne pour copier et coller les tableaux sans les formules pour ne pas que les valeurs se mettent à jours. Mais je n'arrive donc pa sà rajouter la copie de tous les graphiques présents et les coller en images.. J'ai essayé en enregistrant une macro et rajouter le code ensuite mais vue que je ne maîtrise pas du tout VBA àa merde ..

 

[Efgé]

Re

En remplaçant ta partie de code par la mienne, tu as le résultat demandé (avec de vrais graphiques)

Cordialement

 

[richard31]

Re

En remplaçant ta partie de code par la mienne, tu as le résultat demandé (avec de vrais graphiques)

Cordialement

ça fonctionne mais les tableaux restent liés à des données d'autres feuilles. En fait il faut une copie des graph en images. je ne dois garder aucunes liaisonset aucunes formules dans les tableaux ( ce qui fonctionne avec l ancien code ). J ai trouvé la commande en copie image :
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
eT
ActiveSheet.Pictures.Paste.Select

Mais comment sélectionner tous les graph et surtout donc les coller dans la nouvelle feuille.. pfff

 

[Efgé]

Re

Chez moi, les graphiques sont liés à la source crée et non la feuille d'origine.

Je ne me lance pas dans la création d'images multiples.
D'autres auront certainement des suggestions.

Cordialement

 

[richard31]

Re

Chez moi, les graphiques sont liés à la source crée et non la feuille d'origine.
Regarde la pièce jointe 998752

Je ne me lance pas dans la création d'images multiples.
D'autres auront certainement des suggestions.

Cordialement

Oui je parle des graphiques en dessous Effectivement ces deux là fonctionnent
Je vais essayer de trouver comment faire ça ou une commande qui transforme tous les graphiques d'une page en Image .

Merci quand même !