Besoin d'aide pour simplification d'un code VBA

[Résolu/Fermé]
Signaler
Messages postés
18
Date d'inscription
mercredi 3 février 2016
Statut
Membre
Dernière intervention
3 mars 2021
-
Messages postés
18
Date d'inscription
mercredi 3 février 2016
Statut
Membre
Dernière intervention
3 mars 2021
-
Bonjour,

j'ai besoin d'aide pour simplifier un code VBA et le rendre plus fluide si besoin de changement.



Sub Export_des_données()
Dim LastRow As Long

Workbooks.Open Filename:="I:GPCHAUSR\DISTRIBUTION_FICHE.xlsm"

LastRow = Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("A" & Rows.Count).End(xlUp).Row

With Application.Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche")

Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("B4").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("A" & LastRow + 1).PasteSpecial xlPasteValues
Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("B6").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("F" & LastRow + 1).PasteSpecial xlPasteValues
Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("F5").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("C" & LastRow + 1).PasteSpecial xlPasteValues
Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("B15").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("D" & LastRow + 1).PasteSpecial xlPasteValues
Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("B23").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("E" & LastRow + 1).PasteSpecial xlPasteValues
Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("A2").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("H" & LastRow + 1).PasteSpecial xlPasteValues
Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche").Range("B5").Copy
Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("I" & LastRow + 1).PasteSpecial xlPasteValues


Application.CutCopyMode = False


ActiveWorkbook.Save
ActiveWindow.Close

Application.ScreenUpdating = False

End Sub


Pouvez vous m'aider ?

cordialement

1 réponse

Messages postés
1953
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
12 août 2021
151
Bonjour,

Ton code ne comprend pas de End With, c'est bizarre...
J'essaie (pas à l'abri d'une erreur de syntaxe :

Sub Export_des_données()
Dim LastRow As Long

Workbooks.Open Filename:="I:GPCHAUSR\DISTRIBUTION_FICHE.xlsm"

LastRow = Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche").Range("A" & Rows.Count).End(xlUp).Row

With Workbooks("FICHE_DETECTION.xlsm").Worksheets("Fiche")
a=.Range("B4").Value 
f=.Range("B6").Value 
c=.Range("F5").Value 
d=.Range("B15").Value 
e=.Range("B23").Value 
h=.Range("A2").Value 
i=.Range("B5").Value 
End With 

With Workbooks("DISTRIBUTION_FICHE.xlsm").Worksheets("Fiche")
.Range("A" & LastRow + 1).Value = a
.Range("F" & LastRow + 1).Value = f
.Range("C" & LastRow + 1).Value = c
.Range("D" & LastRow + 1).Value = d
.Range("E" & LastRow + 1).Value = e
.Range("H" & LastRow + 1).Value = h
.Range("I" & LastRow + 1).Value = i 
End With
 
ActiveWorkbook.Save
ActiveWindow.Close
   
End Sub


Là ça colle à peu près à la syntaxe d'origine, on peut aussi créer une macro à paramètres (nom de fichier + nom de feuille + cellule, pour origine et destination) et appeler cette macro pour chaque recopie.

A+
Messages postés
18
Date d'inscription
mercredi 3 février 2016
Statut
Membre
Dernière intervention
3 mars 2021

Génial c'est ce que j'essayais de faire mais je ne savais pas comment m'y prendre ;)