Microsoft 365 Simplification de mon code VBA

K

Keiko

XLDnaute Occasionnel
Bonjour,

voici un code qui fonctionne mais je souhaiterais voir si il ne peut pas être amélioré.
Le code permet de choisir un fichier fermé, de l'ouvrir et copier les cellules choisies et de les coller dans le fichier ouvert en fermant tout de suite après une fois coller le fichier à la base fermé.

J'ai plusiuers cellules a copier et je voulais savoir si on ne pouvait simplifier le codage afin de toutes les ajouter sans devoir tout le temps recopier ce code
"NewBook.Activate
Sheets("L").Range("G14:G21").Copy
nomUn.Activate
Worksheets("L").Range("G14:G21").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False"

De plus, ca fonctionne quand même mais je recois tout le temps à la fin un message me disant "Vous n'avez pas sélectionné de fichier" alors que tout a fonctionné.

Merci pour votre aide !

VB: 
Sub recuperer()

Dim QuelFichier
    QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    If QuelFichier <> False Then
          
        Copie (QuelFichier)
          
        End If
    
        MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
  
Sub Copie(QuelFichier)
Dim nomUn, NewBook As Workbook 'Modification ici
Set nomUn = ThisWorkbook
 
Set NewBook = Workbooks.Open(QuelFichier)  'Modification ici
NewBook.Activate
Sheets("L").Range("D14:D21").Copy
nomUn.Activate
Worksheets("L").Range("D14:D21").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
NewBook.Activate
Sheets("L").Range("G14:G21").Copy
nomUn.Activate
Worksheets("L").Range("G14:G21").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  
 
NewBook.Close False
 
End Sub
 
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Bonjour,
Une simplification parmi tant d'autres :
VB: 
Sub recuperer()

Dim QuelFichier
    QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    If QuelFichier <> False _
    Then Copie (QuelFichier) _
    Else MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
 
Sub Copie(QuelFichier)
Dim Target As Worksheet, Plage As Variant
Set Target = ThisWorkbook.Worksheets("L")
    
    Application.ScreenUpdating = False
    With Workbooks.Open(QuelFichier)
        For Each Plage In Array("D14:D21", "G14:G21")
            .Worksheets("L").Range(Plage).Copy
            Target.Range(Plage).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next
        .Close False
    End With
    Application.ScreenUpdating = True
 
End Sub
 
Vote positif 0 Vote négatif
Deadpool_CC

Deadpool_CC

XLDnaute Accro
Salut.
Après c'est toi qui va maintenir le Code donc ce que tu as fait = tu le comprends et maitrise
C'est mieux de le conserver pour son évolution future
Selon moi ... faut penser optimisation s'il y a des soucis de performance avant tout :)
Enfin ce que j'en dis ... tu fera bien comme tu veux ... lol
 
Vote positif 0 Vote négatif
K

Keiko

XLDnaute Occasionnel
Un grand merci :)

Quand le fichier fermé s'ouvre pour copier les cellules avant de rentrer, il y a un User et un mot de passe à encoder.
Possible que quand il s'ouvre, il encode le User et le Mot de passe ainsi pas d'encodage et il coipe et colle directement dans le fichier ouvert?

Voici un code que j'utilise pour le débloquer mais ca marche avec le code ci-dessus.

Peut-on l'incorporer dans le code ci-dessus?

VB: 
'on saisit le user
    User = InputBox("Veuillez saisir votre nom d'utilisateur", "Utilisateur")
'on saisit le mot de passe
    MDP = InputBox("Veuillez saisir votre mot de passe", "Mot de passe")

ElseIf User = "JD" And MDP = "Jpc42*" Then
            For i = 1 To ThisWorkbook.Sheets.Count
             If Sheets(i).Name <> "Intro" Then Sheets(i).Visible = True
            Next
            Worksheets("L").[D10] = "Jonathan Dethier"
            
            Application.ScreenUpdating = True
 
Vote positif 0 Vote négatif
K

Keiko

XLDnaute Occasionnel
Merci pour ton aide.

J'ai créé un bouton pour ouvrir un excel fermé copier des cellules vers le dossier ou se trouve le bouton.
Pour le moment à l'ouverture du fichier source (fichier fermé), on doit encoder le User et MP pour l'ouvrir et qu'il copie et colle vers le fichier ouvert (avec le bouton).

Voici le code qui permet de faire ca :

VB: 
Sub recuperer()

Dim QuelFichier
    QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    If QuelFichier <> False _
    Then Copie (QuelFichier) _
    Else MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
 
Sub Copie(QuelFichier)
Dim Target As Worksheet, Plage As Variant
Set Target = ThisWorkbook.Worksheets("L")
    
    Application.ScreenUpdating = False
    With Workbooks.Open(QuelFichier)
        For Each Plage In Array("D14:D21", "G14:G21")
            .Worksheets("L").Range(Plage).Copy
            Target.Range(Plage).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next
        .Close False
    End With
    Application.ScreenUpdating = True
 
End Sub

Pourrait-on à l'ouverture faire en sorte qu'il donne le user et le mot de passe ainsi on aurait pas besoin de l'encoder et cela se ferait autommatiquement.

Voici le :

User : JD
MP : Jpc42*

Une fois encodé cela ouvre le fichier et ainsi copie et colle vers le fichier ouvert.

Ai-je été assez précis?

Bien à toi,
 
Vote positif 0 Vote négatif
K

Keiko

XLDnaute Occasionnel
Merci pour ton aide mais malheureusement ce n'est pas ca.

Voici le code dans le Thisworkbook

VB: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'on affiche la feuille Vierge
    Sheets("L").Visible = True
'on planque toutes les autres feuilles sauf Vierge
    For x = 1 To ThisWorkbook.Sheets.Count
        If Sheets(x).Name <> "L" Then Sheets(x).Visible = xlSheetVeryHidden
    Next
 
End Sub

Private Sub Workbook_Open()
      On Error Resume Next
    Application.ScreenUpdating = False
'on defini un pointeur
    Pointeur = 0
    
'on affiche la feuille Vierge
    Sheets("L").Visible = True
'on va dessus
    Sheets("L").Activate
'on planque toutes les autres
    For x = 1 To ThisWorkbook.Sheets.Count
        If Sheets(x).Name <> "L" Then Sheets(x).Visible = xlSheetVeryHidden
    Next
  
'on saisit le user
    User = InputBox("Veuillez saisir votre nom d'utilisateur", "Utilisateur")
'on saisit le mot de passe
    MDP = InputBox("Veuillez saisir votre mot de passe", "Mot de passe")
  
'Derniere ligne du tableau de la feuille DroitsUsers pour boucler dessus
    DerLigne = Sheets("DroitsUsers").Range("A65536").End(xlUp).Row
  
'on boucle pour trouver les occurences, x=2 car je pars du principe que la premiere ligne _
contient les entetes de colonne
    For x = 2 To DerLigne
'si ce qu'il y a dans la colonne1 (Colonne A : user) = le user saisi _
ET ce qu'il y a dans la colonne2 (Colonne B : mot de passe)
        If Worksheets("DroitsUsers").Cells(x, 1) = User And Worksheets("DroitsUsers").Cells(x, 2) = MDP Then
'on affiche la feuille définié en colonne3 (Colonne C : Onglet autorisé)
'on affiche la feuille correspondante
            FeuilleVisible = Worksheets("DroitsUsers").Cells(x, 3)
            Sheets(FeuilleVisible).Visible = True
'on va dessus
            Sheets(FeuilleVisible).Activate
'on se met un pointeur pour voir si on trouve quelque chose, si on trouve rien on quittera
            Pointeur = Pointeur + 1
            
            Worksheets("L").[D10] = Sheets("DroitsUsers").Cells(x, 4) 'info de la colonne D : en feuille L
    

            
ElseIf User = "JD" And MDP = "Jpc42*" Then
            For i = 1 To ThisWorkbook.Sheets.Count
             If Sheets(i).Name <> "Intro" Then Sheets(i).Visible = True
            Next
            Application.ScreenUpdating = True
        Exit Sub
        
        End If
 
    Next x
 
'Si le pointeur est 0 on ferme le fichier.
    If Pointeur = 0 Then
        MsgBox "Utilisateur ou mot de passe non valide" & vbCrLf & vbCrLf & "Le fichier va se fermer", vbCritical + vbOKOnly, "Sécurité"
        ActiveWorkbook.Close SaveChanges:=False
    End If
 
    Application.ScreenUpdating = True
End Sub

Ca ouvre une première demande le User puis MP et ca permet de rentrer dans l'excel qu'on ouvre.

Il faudrait que quand il ouvre le fichier pour aller copier, le code se met automatiquement s'en l'encoder.

Possible?

Bien à toi,
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
OK, on va donc ouvrir les classeurs à copier sans activer leur macro .

Mais j'attire votre attention sur 2 points:
  1. afficher un mot de passe en clair , c'est pas bien ... 😩
  2. on peut toujours faire Ctrl+Attn pour arrêter la macro en cours :rolleyes:

VB: 
Sub recuperer()
Dim QuelFichier As Variant: QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    
    If QuelFichier <> False _
    Then Copie (QuelFichier) _
    Else MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
 
Sub Copie(QuelFichier)
Dim Plage As Variant
Dim Target As Worksheet: Set Target = ThisWorkbook.Worksheets("L")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With Workbooks.Open(QuelFichier)
        For Each Plage In Array("D14:D21", "G14:G21")
            .Worksheets("L").Range(Plage).Copy
            Target.Range(Plage).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next
        .Close False
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

K
  • Question
Microsoft 365 Eporter donner d'un excel fermé vers excel de travail
Réponses
1
Affichages
565
Hasco
Hasco
M
  • Question
Microsoft 365 Erreur de format
Réponses
5
Affichages
336
Marvin57
M
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
903
TooFatBoy
TooFatBoy
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
658
olivier388
O
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
474
Usine à gaz
Usine à gaz
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
276
farid
F
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
X
  • Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
613
Xender
X
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
812
mouchtre
mouchtre

Membres actuellement en ligne

19 membres et 196 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 626
Messages
2 111 291
Membres
111 092
dernier inscrit
ThomasU3