Microsoft 365 Simplification de mon code VBA

Keiko

XLDnaute Junior
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
 

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
 

Deadpool_CC

XLDnaute Impliqué
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
 

Keiko

XLDnaute Junior
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
 

Keiko

XLDnaute Junior
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,
 

Keiko

XLDnaute Junior
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,
 

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
 

Discussions similaires

Réponses
4
Affichages
248
Réponses
1
Affichages
688
Réponses
10
Affichages
388

Statistiques des forums

Discussions
299 952
Messages
1 980 338
Membres
207 060
dernier inscrit
Maggie2401