Discussion :

[Ghost0000]

Bonjour à tous,

Je souhaiterai copier-coller 4 sheets en direction d'un nouveau classeur, puis par la suite enregistrer en xlsx et fermer ce nouveau classeur. Enfin je souhaiterai continuer à effectuer des opérations sur mon classeur xlsm. (réinitialiser la base de données)

Voici mon code : (j'ai une erreur sur la ligne en rouge: la méthode Copy de la classe Sheets a échoué)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 'Ouverture d'un nouveau classeur vierge
    ActiveWindow.DisplayWorkbookTabs = True
    
    Dim objWorkbookSource As Workbook, objWorkbookCible As Workbook
 
Set objWorkbookSource = ThisWorkbook
Set objWorkbookCible = Workbooks.Add()

    objWorkbookSource.Sheets(Array("Rapport", "Rapport Semaine", "Densité", "BDD")).Copy
    objWorkbookSource.Sheets(Array("Rapport", "Rapport Semaine", "Densité", "BDD")).Copy objWorkbookCible 
    
With objWorkbookCible
    Sheets("Rapport").Activate
    ActiveSheet.Unprotect "protection"
    Sheets("Rapport Semaine").Activate
    ActiveSheet.Unprotect "protection"
    Sheets("BDD").Activate
    ActiveSheet.Unprotect "protection"
End With

'Enregistrement XLSX puis fermeture du document
Application.DisplayAlerts = False
objWorkbookCible.SaveAs Filename:="" & chemin2 & nom & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
objWorkbookCible.Close

'On retourne sur le formulaire original afin de terminer les opérations :
Windows("Gestion.xlsm").Activate
Sheets("Carte").Select
ActiveWindow.DisplayWorkbookTabs = False

'Appel de la fonction mise à zero des captions du sheet "Rapport semaine"
Miseazero_caption

'On supprime le contenu de la BDD
Sheets("BDD").Select
Sheets("BDD").Unprotect Sheets("MDP").Range("G7").Value
Sheets("BDD").Range("A3:ZZ99999").ClearContents
Range("A3").Select
Sheets("BDD").Select
Sheets("BDD").Protect Sheets("MDP").Range("G7").Value

'Modification de la valeur de la variable de changement de mois
Sheets("MDP").Unprotect Sheets("MDP").Range("G8").Value
Sheets("MDP").Range("G5").Value = Month(Date)
Sheets("MDP").Protect Sheets("MDP").Range("G8").Value

'On revient sur la vue "Carte"
Sheets("Carte").Activate
With ActiveWindow
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
End With

MsgBox "Données du mois précédent sauvegardé :" & vbCr & nom & ".pdf" & vbCr & nom & ".xlsx"

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Merci d'avance pour votre aide !

GK

[Ghost0000]

J'y suis arrivé en cherchant un peu partout ^^ (En bleu les lignes que je cherché et là où j'ai eu un peu de mal ! ça peut servir pour quelqu'un d'autre)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
 'Copier-coller des sheets en direction de l'autre classeur
    ActiveWindow.DisplayWorkbookTabs = True
    Application.ScreenUpdating = False
    ActiveWorkbook.Sheets(Array("Rapport", "Rapport Semaine", "Densité", "BDD")).Copy
    
    With Windows(2)
        Application.ScreenUpdating = False
        Sheets("Rapport").Activate
        ActiveSheet.Unprotect "protection"
        Sheets("Rapport Semaine").Activate
        ActiveSheet.Unprotect "protection"
        Sheets("Densité").Activate
        ActiveSheet.Unprotect "protection"
        Sheets("BDD").Activate
        ActiveSheet.Unprotect "protection"
        Sheets("Rapport").Activate
        
        'Suppression des boutons inutiles dans le rapport XLSX
        ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
        Selection.Delete
        Sheets("Rapport Semaine").Select
        ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
        Selection.Delete
        ActiveSheet.Shapes.Range(Array("CommandButton2")).Select
        Selection.Delete
        Sheets("Densité").Select
        ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
        Selection.Delete
        ActiveSheet.Shapes.Range(Array("CommandButton2")).Select
        Selection.Delete
        Sheets("BDD").Select
        ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
        Selection.Delete
        ActiveSheet.Shapes.Range(Array("CommandButton2")).Select
        Selection.Delete
        
        'Par défaut on affichera l'onglet "Rapport"
        Sheets("Rapport").Activate
    End With

'Enregistrement XLSX puis fermeture du document
With Windows(2)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="" & chemin2 & nom & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
End With

'On retourne sur le formulaire original afin de terminer les opérations :
Windows("Gestion.xlsm").Activate
Application.ScreenUpdating = True
Sheets("Carte").Select
Application.ScreenUpdating = False
ActiveWindow.DisplayWorkbookTabs = False

'Appel de la fonction mise à zero des captions du sheet "Rapport semaine"
Miseazero_caption

'On supprime le contenu de la BDD
Sheets("BDD").Select
Sheets("BDD").Unprotect Sheets("MDP").Range("G7").Value
Sheets("BDD").Range("A3:ZZ99999").ClearContents
Range("A3").Select
Sheets("BDD").Select
Sheets("BDD").Protect Sheets("MDP").Range("G7").Value

'Modification de la valeur de la variable de changement de mois
Sheets("MDP").Unprotect Sheets("MDP").Range("G7").Value
Sheets("MDP").Range("G5").Value = Month(Date)
Sheets("MDP").Protect Sheets("MDP").Range("G7").Value

'On revient sur la vue "Carte"
Sheets("Carte").Activate
With ActiveWindow
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
End With
Sheets("Carte").Protect Sheets("MDP").Range("G7").Value

MsgBox "Données du mois précédent sauvegardé :" & vbCr & nom & ".pdf" & vbCr & nom & ".xlsx"

[clementmarcotte]

Bonjour,

Ce n'est pas (toujours) nécessaire de copier-coller; surtout pour une feuille complète. Ouvre Excel et deux classeurs.

Puis enregistre et élague une macro avec cela:

Clic-droit sur le nom de ta feuille
Clique sur Déplacer et copier
Choisis l'autre classeur dans le liste déroulante.
Si tu veux copier tu clique la case

Arrête l'enregistrement.

[Philippe Tulliez]

Bonjour,
Comme le fait très justement remarquer Clément, il est parfaitement inutile de passer par toutes ces opérations de Insertion, Copier/Colle et Suppression (s'il s'agit de déplacement) lorsque l'on doit copier ou déplacer une feuille entière.
Il a parfaitement décrit ce qu'il faut faire manuellement

Ce qui se résume en VBA par

Copier une feuille d'un classeur vers un classeur existant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks("NomClasseurSource.xlsx").Sheets("NomFeuille").Copy After:=Workbooks("NomClasseurCible.xlsx").Sheets(1)

Copier une feuille d'un classeur vers un nouveau classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks("NomClasseurSource.xlsx").Sheets("NomFeuille").Copy

Déplacer une feuille d'un classeur vers un classeur existant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks("NomClasseurSource.xlsx").Sheets("NomFeuille").Move After:=Workbooks("NomClasseurCible.xlsx").Sheets(1)

Déplacer une feuille d'un classeur vers un nouveau classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks("NomClasseurSource.xlsx").Sheets("Db").Move