Excel copie feuille 1 = contenu de cellules Fermé

Question

Salut tout le monde.
-
J'ai besoin d'un petit coup de main.
-
Je suis professeur et j'aimerais créer un fichier Excel qui contient dans la première page un compte rendu d'intervention vierge.
-
Le but c'est que les élèves complètent le compte rendu, l'archive, le vide et l'enregistre.
-
Pour moi l'archivage consistera à faire une copie du compte rendu dans le même classeur et qu'il porte le nom de l'élève et la date du jour qu'il aura complété dans deux cellules du compte rendu.
-
Voilà le code que j'ai créé pour archiver le compte rendu celui-ci ne marche pas.
-
Sheets("Feuil1").Select  
Selection.Copy  
Sheets.Add  
ActiveSheet.Name = Range("A1") & Range("A2")
-
Voilà le code que j'ai créé pour effacer le compte rendu
-
Range("A1,A2,E7,G7,G9,E9,E11,G11,G13,E13").Select  
Selection.ClearContents  
Range("A1").Select
-
Voilà le code que j'ai créé pour enregistrer le fichier
ActiveWorkbook.Save
-
Pouvez-vous me dire ce qui ne va pas ?
-
Merci pour votre aide.

ccm81 · Answer

bonsoir

peut etre quelque chose comme ça

Dim nomFE As String
Dim plage As Range
With Sheets("Feuil1")
  nomFE = .[A1] & "-" & .[A2]
  Set plage = Union(.[A1], .[A2])
End With
Sheets("Feuil1").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = nomFE
plage.ClearContents
Sheets("Feuil1").Select
Range("A1").Select
ActiveWorkbook.Save
bonne suite

ccm81 · Answer

re 

Dim nomE As String 
Dim plage As Range 
Dim dj As String 
With Sheets("Feuil1") 
  nomE = .[A1] 
  Set plage = Union(.[A1], .[A2])      ' à compléter ....
  dj = Format(.[A2], "dd-mm-yyyy") 
End With 
Application.ScreenUpdating = False 
Sheets("Feuil1").Copy after:=Sheets(Sheets.Count) 
Sheets(Sheets.Count).Name = nomE & "-" & dj 
plage.ClearContents 
Application.ScreenUpdating = True 
Sheets("Feuil1").Select 
Range("A1").Select 
ActiveWorkbook.Save
devrait régler le pb

RQ. il faudrait peut être envisager quelque chose si la feuille à créer existe déjà pour éviter un plantage

bonne suite

yen-aplu · Answer

Super beau travail merci beaucoup ccm81

Voilà comment j'ai adapté ton code à mon projet

L'élève rentre son nom en B4

Dans la cellule o4 j'ai rentré la fonction = maintenant (format jj mmm aaaa hh:mm:ss)

J'ai extrais les minutes dans la cellule AA2 car si je met :
minute = Format(.O4], "mm") j'ai le mois

Ensuite je fais une copie du gabarit sans les formules pour éviter que la date change dans l'archive.

Je supprime les colonnes W:AB car dans le gabarit j'ai 3 boutons auquel j'ai associé les macros archiver, vider et enregistrer.

au final l'archive est nommée : MARTIN-12.juin.2011-13H19min52s

Plus de problème si la feuille à créer existe déjà car chaque seconde donne un nouveau nom.

Encore merci pour ton aide.

Sub Archiver_compte_rendu_correctif()

Dim nomE As String
Dim dj As String
Dim heure As String
Dim minute As String
Dim seconde As String

With Sheets("Compresseur compte rendu correc")

nomE = .[B4]
dj = Format(.[O4], "dd.mmm.yyyy")
heure = Format(.O4], "hh")
minute = .[AA2]
seconde = Format(.[O4], "ss")

End With

Sheets("Compresseur compte rendu correc").Copy After:=Sheets(Sheets.Count)

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Sheets(Sheets.Count).Name = nomE & "-" & dj & "-" & heure & "H" & minute & "min" & seconde & "s"

Columns("w:AB").Select
Selection.Delete Shift:=xlToLeft
Range("B2").Select
Sheets("Compresseur compte rendu correc").Select
Range("B2").Select

End Sub

yen-aplu · Answer

Je reviens à la charge :)

Petit soucis de protection

Mon code marche très bien jusqu'à ce que j'active la protection. Impossible de faire une copie du gabarit sans les formules pour éviter que la date change dans l'archive.

Je rajoute donc deux lignes :

ActiveSheet.Unprotect

et

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection

Ça marche très bien mais lors de la réouverture du classeur l'archive n'est plus protégée totalement je peux sélectionner les cellules déverrouillées.

Voilà le code complet :

Sub Archiver_compte_rendu_correctif()

Dim nomE As String
Dim dj As String
Dim heure As String
Dim minute As String
Dim seconde As String

With Sheets("Compresseur compte rendu correc")

nomE = .[B4]
dj = Format(.[o4], "dd.m.yy")
heure = Format(.[o4], "hh")
minute = .[AA2]
seconde = Format(.[o4], "ss")

End With

Sheets("Compresseur compte rendu correc").Copy After:=Sheets(4)

ActiveSheet.Unprotect

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Sheets(5).Name = nomE & "-" & dj & "-" & heure & "H" & minute & "min" & seconde

Columns("w:y").Select
Selection.Delete Shift:=xlToLeft

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection

Sheets("Compresseur compte rendu correc").Select

Range("B2").Select

Excel copie feuille 1 = contenu de cellules

4 réponses

Discussions similaires