XL 2010 Probleme de Copie

fattah_5791

XLDnaute Occasionnel
Bonsoir,

je viens de concevoir une macro me permettant de copier une plage dans une feuille (crée) dans le mm classeur afin de la sauvegarder sous forme d'un classeur.

code:
Sub imprimerCC()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Index").Activate
ThisWorkbook.Unprotect "127261127261 Ea"
If Sheets("Base").Range("AM1").Value = 0 Then
GoTo fin
End If

Sheets("indicateurs").Visible = xlSheetVisible
Sheets("indicateurs").Unprotect "127261127261 Ea"

UserForm1.Show ' userform me permettant d'imprimer soit sous format XLS ou PDF ou imprimer directement sur imprimante
If UserForm1.OptionButton1.Value Then
Unload UserForm1
Dim chemin$, fichier$, Niveau$, classe$
Dim i%
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "IndicateursCC"

Niveau = Sheets("indicateurs").Range("AO1").Value
classe = Sheets("indicateurs").Range("AM1").Value

Sheets("indicateurs").Activate
Worksheets("indicateurs").Range("AG1:AV37").Select
Selection.Copy

Sheets("indicateursCC").Activate
Sheets("IndicateursCC").Range("A1").Select

Application.DisplayAlerts = False
With Selection
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With
Application.DisplayAlerts = True

Sheets("indicateurs").Activate
Sheets("indicateurs").ChartObjects("Graphique 2").Copy
Sheets("indicateursCC").Activate
Sheets("IndicateursCC").Range("A17").Select
Selection.PasteSpecial Paste:=xlPasteFormats

For i = 1 To 34
ActiveSheet.Rows(i).RowHeight = Sheets("Indicateurs").Rows(i).RowHeight
Next i

chemin = ThisWorkbook.Path
fichier = chemin & "\" & "IndicateursCC_" & Niveau & "_" & classe & ".xlsx"
ActiveSheet.Copy

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fichier
Application.DisplayAlerts = True
ActiveWorkbook.Close

MsgBox ("Le fichier exporté a été enregistré sous le nom : " & fichier)
Application.DisplayAlerts = False
Sheets("IndicateursCC").delete
Application.DisplayAlerts = True


ElseIf UserForm1.OptionButton2.Value Then
Unload UserForm1
Dim Vbprinter
Vbprinter = Application.Dialogs(xlDialogPrinterSetup).Show
If Vbprinter = True Then
Sheets("indicateurs").Activate
Range(Cells(1, 33), Cells(37, 48)).Select
Selection.PrintOut Copies:=1
Else: GoTo fin
End If
End If

fin:
Sheets("indicateurs").Visible = xlSheetVeryHidden
Sheets("indicateurs").Protect "127261127261 Ea"

' masquer ttes les feuilles sauf "Index"
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Index" Then
Sheets(i).Visible = xlSheetVeryHidden
End If
Next i

ThisWorkbook.Protect "127261127261 Ea"
Sheets("Index").Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub



la 1ère execution se passe parfaitement en choisissant d'imprimer en XLS, et si je recommence la mm macro, le code se plante au niveau de :
Worksheets("indicateurs").Range("AG1:AV37").Select
Selection.Copy

Merci de m'aider

Excel 2010
windows 10
 

Discussions similaires

Réponses
5
Affichages
112

Statistiques des forums

Discussions
312 198
Messages
2 086 146
Membres
103 130
dernier inscrit
FRCRUNGR