XL 2016 Copier cellule dans un autre onglets

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion hutch57
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
H

hutch57

XLDnaute Occasionnel
Bonsoir le forum,
J'ai un petit souci de macro, je voudrais sauvegarder les cellules D a J dans un autre onglet sachant que dans la feuille les 2 onglets sont protégé par un mot de passe, c'est la que ca coince j'ai essayé de combiner les 2 modules en 1 seul mais ca ne fonctionne pas.
Module1
Sub SaveM2()

Sheets("DP").Select

Range("C6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("D6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If


Range("E6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("F6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("G6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("H6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Module2
Sub test()

ActiveSheet.Unprotect "1234"
Sheets("Datas").Select
ActiveSheet.Unprotect "1234"
Sheets("DP").Select
Range("B6:J6").Select
Selection.Copy
Sheets("Datas").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A8").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("DP").Select
Range("D6:I6").Select
Selection.ClearContents
Range("D6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Un avis! en attendant j'essaye de faire mieux.
 

Pièces jointes

Trier par date Trier par votes
Rebonsoir,
C'est bon ca fonctionne j'ai trouver comment faire, par contre les feuille sont déprotégé puis reprotégé mais sans le mot de passe, bizarre.
Voici la macro modifier
Sub SaveM2()

Sheets("DP").Select


Range("C6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("D6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If


Range("E6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("F6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("G6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If

Range("H6").Select
If ActiveCell = "" Then
MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE"
End
End If


ActiveSheet.Unprotect "1234"
Sheets("Datas").Select
ActiveSheet.Unprotect "1234"
Sheets("DP").Select
Range("B6:J6").Select
Selection.Copy
Sheets("Datas").Select
Range("a65536").End(xlUp).Select

ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A8").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("DP").Select
Range("D6:I6").Select
Selection.ClearContents
Range("D6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
hutch57 à dit:
Apres on peut faire mieux en macro je pense
Cliquez pour agrandir...
Bonjour,
Par exemple
VB: 
Sub SaveM2()
    Dim C As Range
    Application.ScreenUpdating = False
    With Feuil1
        For Each C In .[c6:i6]
            If C = "" Then
                MsgBox "UNE VALEUR EST OBLIGATOIRE POUR CETTE CELLULE (" & C.Offset(-1) & ")"
                C.Select: Exit Sub
            End If
        Next
        Feuil2.Unprotect "1234"
        .[b6:j6].Copy Feuil2.Range("a" & Feuil2.Cells(Rows.Count, "a").End(xlUp).Row + 1)
        Feuil2.Protect "1234"
    End With
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Bonsoir Jacky67,
C'est mieux mais l'heure ne change plus, j'avais mis cette formule dans la feuil1pour ca/
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Sheets("DP").Select
ActiveSheet.Unprotect "1234"
Target.Offset(0, -2) = Date
End If

If Not Application.Intersect(Target, Range("D6")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Sheets("DP").Select
Target.Offset(0, -1) = Time
ActiveSheet.Protect "1234"
End If
End Sub

et il n'efface pas les cellules de D a J sur le feuille DP.
 
Vote positif 0 Vote négatif
hutch57 à dit:
Bonsoir Jacky67,
C'est mieux mais l'heure ne change plus, j'avais mis cette formule dans la feuil1pour ca/
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Sheets("DP").Select
ActiveSheet.Unprotect "1234"
Target.Offset(0, -2) = Date
End If

If Not Application.Intersect(Target, Range("D6")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Sheets("DP").Select
Target.Offset(0, -1) = Time
ActiveSheet.Protect "1234"
End If
End Sub

et il n'efface pas les cellules de D a J sur le feuille DP.
Cliquez pour agrandir...
Ok
La date et l'heure se mettent à jour avec la validation.
La saisie s'efface après validation
 

Pièces jointes

Vote positif 0 Vote négatif
@hutch57

Le code est assez facile à comprendre.

En gros c'est le nom des 2 feuilles que j'ai mise en variable cela évite de les répéter

Set Ws1 = Worksheets("DP") '<== c'est la feuille DP
Set Ws2 = Worksheets("Datas") '<== c'est la feuille Datas
Cliquez pour agrandir...

Chaque fois que j'écris par exemple
Ws1.Range("D6:J6").Value = ""
Cliquez pour agrandir...
C'est comme si j'écris
Worksheets("DP").Range("D6:J6").Value = ""
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Phil,
par contre dans ma feuil1 j'avais ca en code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Sheets("DP").Select
ActiveSheet.Unprotect "*1234*"
Target.Offset(0, -2) = Date
End If

If Not Application.Intersect(Target, Range("D6")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Sheets("DP").Select
Target.Offset(0, -1) = Time
ActiveSheet.Protect "*1234*"
End If
End Sub
Comment tu as intégrer ca dans le code
merci de ton retour
 
Vote positif 0 Vote négatif
Nous passons au zéro publicité… et avons besoin de vous !
Notre forum d’entraide est 100 % gratuit et le restera.
Aucune formation payante, aucun fichier à acheter, rien à vendre. Mais comme tout site, nous devons couvrir nos frais pour continuer à vous accompagner.
Soutenez-nous en souscrivant à un compte membre : c’est rapide, vous choisissez simplement votre niveau de soutien et le tour est joué.

Je soutiens la communauté et j’accède à mon compte membre

Discussions similaires

C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
545
candido57
C
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
855
MICHAEL
M
B
  • Question Question
Microsoft 365 contrôler un EXIT
Réponses
2
Affichages
111
Bill73
B
J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
5
Affichages
191
jalaba
J
D
  • Question Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
624
dadu35
D
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
405
job75
job75
P
  • Résolu(e)
Microsoft 365 Afficher ou masquer formes si une cellule est vide
Réponses
11
Affichages
328
pat66
P
treza88
  • Question Question
XL 2021 Problème ouverture fichier sur feuille protégée
Réponses
6
Affichages
612
treza88
treza88
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
321
Oneida
Oneida
Cédric06400
  • Résolu(e)
Microsoft 365 Déplacement Shape
Réponses
2
Affichages
202
Cédric06400
Cédric06400
T
  • Résolu(e)
XL 2019 Gestion "pseudo-évènements" sur un userform
2
Réponses
15
Affichages
583
ThierryP
T
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
1 K
job75
job75
A
  • Question Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
304
sylvanu
sylvanu
P
  • Résolu(e)
Microsoft 365 Problème avec Application.undo
Réponses
2
Affichages
181
pat66
P
C
  • Résolu(e)
XL 2021 VBA : Afficher plusieurs résultats d'une boucle dans une cellule
Réponses
3
Affichages
159
Claudinedu13
C
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
261
MBEPID
M
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
147
escudo
E
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
342
Phil69970
Phil69970
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
561
Compte Supprimé 979
C
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
368
marie3107
M
Retour