Alléger un code VBA

[hypo78]

Bonjour,

j'ai fait ce bout de code pour copier des données entre classeurs

 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.

 

[hypo78]

Re : Alléger un code VBA

Bsr,

merci pour ces précisions, mais le code s'arrête là

Workbooks(NomClas).Worksheets("01").Range("AC4").Copy

 

[hypo78]

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

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

 

[Paf]

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

 

[hypo78]

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

 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