Besoin d'aide pour simplification d'un code VBA
Résolu
grutz
Messages postés
26
Statut
Membre
-
grutz Messages postés 26 Statut Membre -
grutz Messages postés 26 Statut Membre -
Bonjour,
j'ai besoin d'aide pour simplifier un code VBA et le rendre plus fluide si besoin de changement.
Pouvez vous m'aider ?
cordialement
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
-
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+
