Alléger un code VBA

  • Initiateur de la discussion Initiateur de la discussion hypo78
  • 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 !

hypo78

XLDnaute Impliqué
Bonjour,

j'ai fait ce bout de code pour copier des données entre classeurs
Code:
 Sub MAJpiquets()

Application.ScreenUpdating = False
 
Application.DisplayAlerts = False


Dim rotation As Workbook

For i = 2 To 5

jourgarde = Cells(i, 1)
jourgarde = Format(jourgarde, "dd/mm/yyyy")

gardedujour = ThisWorkbook.Path & "\" & Format(jourgarde, "yyyy") & "\" & Format(jourgarde, "mmmmyyyy") & "\" & Format(jourgarde, "ddmmmmyyyy"".xls")

'MsgBox gardedujour

Workbooks.Open (gardedujour)
Sheets("01").Select
Range("AC4").Select
Selection.Copy
Windows("rotation.xlsm").Activate
    Cells(i, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
        
Workbooks.Open (gardedujour)
Range("AC7").Select
Selection.Copy
ActiveWorkbook.Close False
    Workbooks("rotation.xlsm").Activate
    Cells(i, 3).Select
    ActiveSheet.Paste
        

Next i

End Sub

Dans l'exemple je fais varier i de 2 à 5 alors qu'en réalité ce sera de 2 à 250
et le copier/coller se fait sur une trentaine de cellules non contigues (2 dans l'exemple).

Mon code fonctionne, mais j'aimerai simplifier l'écriture pour le passage d'un classeur à l'autre car çà me parait un peu lourd non?

Merci.
 
Re : Alléger un code VBA

Re

Cela ne ressemble pas à ce que je te suggérais 😉
Set Wbk = ThisWorkbook.Path & "\" & NomClas
Wbk.Open

C'est plutôt ceci que tu aurais du tester
Code:
gardedujour = ThisWorkbook.Path & "\" & Format(jourgarde,  "yyyy") & "\" & Format(jourgarde, "mmmmyyyy") & "\" &  Format(jourgarde, "ddmmmmyyyy"".xls")
set Wbk=Workbooks(gardedujour)
Wbk.Worksheets("01").Range("AC7").Copy

Je te laisse compléter le début et la fin du code 😉 puis tester de nouveau

plantage avec Wbk=vide
 
Re : Alléger un code VBA

Re bonjour



quand j'ai fait mes tests avec mon jeu d'essai, au début je restais bloqué sur la même ligne; j'en ai déduis que dans Workbooks(gardedujour).Worksheets("01").Range("AC4").Copy le classeur gardedujour n'étais pas trouvé. d'où la modification entre nom+chemin et nom seul.
en revoyant les différents codes, j'ai un doute sur le contenu de NomClas:
NomClas = Format(jourgarde, "yyyy") & "\" & Format(jourgarde, "mmmmyyyy") & "\" & Format(jourgarde, "ddmmmmyyyy"".xls")

ca nous donne un nom de fichier du type : 2014\012014\22012014.xls

dans cet exemple 2014\012014\ fait partie du nom du fichier (j'en doute) ou c'est un complément de chemin ?

si c'était un complément de chemin, il faudrait modifier de façon à "isoler" le véritable nom du classeur.
NomClas = Format(jourgarde, "ddmmmmyyyy"".xls")
gardedujour = ThisWorkbook.Path & "\" &Format(jourgarde, "yyyy") & "\" & Format(jourgarde, "mmmmyyyy") & "\" & NomClas


Bonne suite
 
Re : Alléger un code VBA

Bonjour,
quand je suis en mode débogage et que je passe la souris au dessus de nomclass et gardedujour, ils renvoient bien les bonnes valeurs.
Pour confirmer et comme me l'avait demandé Stapple j'avais ajouté une ligne msgbox gardedujour.
D'ailleurs comme je le dis plus haut quand je passe par open/copy/activate (voir message de 21H55) çà fonctionne.

Pour le coup je ne sais pas si je gagne du temps avec ce code par rapport à une formule dans les cellules qui vont chercher les données dans l'autre classeur.....

Edit : là çà fonctionne et 1 seul open

Code:
 Sub MAJpiquets()

Application.ScreenUpdating = False
 
Application.DisplayAlerts = False
Dim i As Long
Dim Cible As Workbook, Source As Workbook
Set Cible = ThisWorkbook



For i = 2 To 10

jourgarde = Cells(i, 1)
jourgarde = Format(jourgarde, "dd/mm/yyyy")

gardedujour = ThisWorkbook.Path & "\" & Format(jourgarde, "yyyy") & "\" & Format(jourgarde, "mmmmyyyy") & "\" & Format(jourgarde, "ddmmmmyyyy"".xls")

MsgBox gardedujour

Set Source = Application.Workbooks.Open(gardedujour)
Sheets("01").Range("AC4").Copy
    Cible.Activate
    Cells(i, 2).PasteSpecial Paste:=xlPasteValues
    
Source.Activate
Sheets("01").Range("AC7").Copy
    Cible.Activate
    Cells(i, 3).PasteSpecial Paste:=xlPasteValues
    
Source.Activate
Sheets("01").Range("AT4").Copy
    Cible.Activate
    Cells(i, 4).PasteSpecial Paste:=xlPasteValues
    
Source.Activate
Sheets("01").Range("AT7").Copy
ActiveWorkbook.Close False
    Cible.Activate
    Cells(i, 5).Select
    ActiveSheet.Paste
        

Next i

End Sub
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
512
Retour