Alléger un code VBA

hypo78

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.
 
Trier par date Trier par votes
Paf

Paf

XLDnaute Barbatruc
Re : Alléger un code VBA

Bonjour à tous,



une proposition d'allègement qui évite d'ouvrir 2 fois chaque fichier source

Code: 
For i = 2 To 5
Cible = ActiveWorkbook.Name
jourgarde = Cells(i, 1)
jourgarde = Format(jourgarde, "dd/mm/yyyy")


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

    Workbooks.Open (gardedujour)
    Workbooks(NomClas).Worksheets("Feuil1").Range("AC4").Copy
    Workbooks(Cible).Worksheets("Feuil1").Cells(i, 2).PasteSpecial Paste:=xlPasteValues
    
    Workbooks(NomClas).Worksheets("Feuil1").Range("AC7").Copy Workbooks(Cible).Worksheets("Feuil1").Cells(i, 3)

    Workbooks(NomClas).Close False      
Next i

Bonne suite
 
Vote positif 0 Vote négatif
hypo78

hypo78

XLDnaute Impliqué
Re : Alléger un code VBA

Bsr,

le code plante toujours à ce niveau

Code: 
Workbooks(gardedujour).Worksheets("01").Range("AC7").Copy

si je remplace par

Code: 
 Workbooks.Open (gardedujour)

Sheets("01").Select

Range("AC4").Select

Selection.Copy

Workbooks(Cible).Worksheets("Feuil1").Cells(i, 2).PasteSpecial Paste:=xlPasteValues

çà fonctionne...

comment supprimer tous ces Select et open?

Merci
 
Vote positif 0 Vote négatif
hypo78

hypo78

XLDnaute Impliqué
Re : Alléger un code VBA

ce code là ne plante pas mais çà reste un peu lourd.....

Code: 
 Sub MAJpiquets()

Application.ScreenUpdating = False
 
Application.DisplayAlerts = False


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").Range("AC4").Copy
    Workbooks("rotation.xlsm").Activate
    Cells(i, 2).PasteSpecial Paste:=xlPasteValues
        
Workbooks.Open (gardedujour)
Sheets("01").Range("AC7").Copy
ActiveWorkbook.Close False
    Workbooks("rotation.xlsm").Activate
    Cells(i, 3).Select
    ActiveSheet.Paste
        

Next i

End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Alléger un code VBA

Re

hypo78 à dit:
Bsr Staple1600,

la déclaration ne change rien....
Cliquez pour agrandir...

Je ne dirais pas cela...
Et il ne s'agissait pas que de la déclaration (il faut lire attentivement le message précédent ;) notamment ce qui était en gras ...)

Et pourquoi avoir zappé la proposition d'allégement de Paf et repartir avec le code qui ouvre deux fois le classeur ???
 
Dernière édition:
Vote positif 0 Vote négatif
hypo78

hypo78

XLDnaute Impliqué
Re : Alléger un code VBA

Adaptation du code de Paf

Code: 
 Sub MAJpiquets()

Application.ScreenUpdating = False
 
Application.DisplayAlerts = False


For i = 2 To 5
Cible = ActiveWorkbook.Name
jourgarde = Cells(i, 1)
jourgarde = Format(jourgarde, "dd/mm/yyyy")


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

MsgBox gardedujour
    

Workbooks.Open (gardedujour)
Workbooks(gardedujour).Worksheets("01").Range("AC4").Copy
Workbooks(Cible).Worksheets("Feuil1").Cells(i, 2).PasteSpecial Paste:=xlPasteValues


Workbooks(gardedujour).Worksheets("01").Range("AC7").Copy
Workbooks(Cible).Worksheets("Feuil1").Cells(i, 3).Paste
ActiveWorkbook.Close False
    
        

Next i

End Sub

qui stoppe là :

Code: 
 Workbooks(gardedujour).Worksheets("01").Range("AC4").Copy


Avec la proposition de Stapple

Code: 
 Sub MAJpiquets()

Application.ScreenUpdating = False
 
Application.DisplayAlerts = False
Dim Wbk As Workbook

For i = 2 To 5

Cible = ActiveWorkbook.Name
jourgarde = Cells(i, 1)
jourgarde = Format(jourgarde, "dd/mm/yyyy")


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


MsgBox gardedujour
    

Workbooks.Open (gardedujour)
Wbk.Worksheets("01").Range("AC4").Copy
Workbooks(Cible).Worksheets("Feuil1").Cells(i, 2).PasteSpecial Paste:=xlPasteValues


Wbk.Worksheets("01").Range("AC7").Copy
Workbooks(Cible).Worksheets("Feuil1").Cells(i, 3).Paste
ActiveWorkbook.Close False
    
        

Next i

End Sub

dans ce cas çà stoppe là : workbooks (gardedujour) -> l'indice n'appartient pas à la sélection

Code: 
 Set Wbk = Workbooks(gardedujour)
 
Dernière édition:
Vote positif 0 Vote négatif
hypo78

hypo78

XLDnaute Impliqué
Re : Alléger un code VBA

un autre essai

Code: 
Sub MAJpiquets()

Application.ScreenUpdating = False
 
Application.DisplayAlerts = False

Dim Wbk As Workbook
Dim Cible As Workbook



For i = 2 To 5

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


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


    
Wbk.Open
Wbk.Worksheets("01").Range("AC4").Copy
Cible.Worksheets("Feuil1").Cells(i, 2).PasteSpecial Paste:=xlPasteValues


Wbk.Worksheets("01").Range("AC7").Copy
Cible.Worksheets("Feuil1").Cells(i, 3).Paste
ActiveWorkbook.Close False
    
        

Next i

End Sub

et çà s'arrête là....

Code: 
 Set Wbk = ThisWorkbook.Path & "\" & NomClas

en plaçant le curseur au dessus de thisworkbook.path et NomClas c'est les bonnes adresses et au dessus de Wbk = nothing
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : Alléger un code VBA

bonsoir à tous,

j'ai omis de préciser dans mon code pourquoi j'utilisais gardedujour et NomClas pour désigner les fichiers.
gardedujour contient le chemin et le nom du fichier

NomClas ne contient que le nom du fichier

Workbooks.Open (gardedujour) fonctionne quand le fichier est fermé (il faut le chemin pour trouver le classeur sur le disque dur)
Workbooks(gardedujour).Worksheets("01").Range("AC4").Copy ne fonctionne pas parce que le code ne trouve pas le fichier chemin+nom de fichier qui est déjà ouvert (une fois ouvert le fichier ne se nomme plus que par son nom et non par chemin + nom)

Il faut lui préciser le seul nom du classeur:
Workbooks(NomClas).Worksheets("01").Range("AC4").Copy


Il y a peut-être d'autres solutions ?

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
358
M@xu3L
M
A
  • Résolu(e)
XL 2016 Alimentation d'un fichier selon données sélectionnées via une ComboBox
Réponses
3
Affichages
309
Aldonanou
A
T
  • Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
343
troki74
T
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
640
TooFatBoy
TooFatBoy
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
381
un internaute
U
C
  • Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
323
Cheyenne_2021
C
looky62
  • Question
Microsoft 365 VBA creation d'un export vers un fichier CSV
Réponses
12
Affichages
386
vgendron
vgendron
C
  • Question
XL 2019 Tableau- creation de lignes: probleme de hauteur de lignes
Réponses
6
Affichages
389
Cheyenne_2021
C
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
609
fanfan38
fanfan38

Membres actuellement en ligne

19 membres et 97 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
312 215
Messages
2 086 319
Membres
103 177
dernier inscrit
grizly