Besoin d'aide pour simplification d'un code VBA

Résolu/Fermé

grutz Messages postés 22 Date d'inscription mercredi 3 février 2016 Statut Membre Dernière intervention 20 septembre 2023 - 17 nov. 2016 à 14:16
grutz Messages postés 22 Date d'inscription mercredi 3 février 2016 Statut Membre Dernière intervention 20 septembre 2023 - 17 nov. 2016 à 16:30

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

A voir également:

Besoin d'aide pour simplification d'un code VBA
Code asci - Guide
Code puk bloqué - Guide
Code telephone oublié - Guide
Code blocks free - Télécharger - Langages
Comment créer un qr code - Guide

1 réponse

Réponse 1 / 1

Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
17 nov. 2016 à 15:01

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+

grutz Messages postés 22 Date d'inscription mercredi 3 février 2016 Statut Membre Dernière intervention 20 septembre 2023
17 nov. 2016 à 16:30

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

Discussions similaires

Code de renvoi d'appel : Ooredo, Mobilis...

Codes bateaux et avion GTA vice city Stories

Acces à snapchat temporairement désactivé

code d'activation GTA 5 steam

Discussions similaires

Newsletters