[XL-2016] Macro pour récupérer des data

Macro pour récupérer des data

Bonjour à vous,

Je suis en train de réaliser une macro qui va chercher des données dans un fichier et les copie colle dans un autre.
Le problème est qu'il me faut la copie en valeur ce qui semble poser problème avec le format des cellules lorsque mon macro essaye de coller.
J'avais réussi à parer ce problème mais malheureusement il s'avère que ma solution ne fonctionne plus ( je n'ai pas trouvé l'origine de cette arrêt par ailleurs.)

J'ai donc besoin de vous afin de trouver une solution simple pour réaliser les actions de ma macro qui se résume en gros à :
- Ouvrir fichier A, selectionner sur la page 2 de ce fichier la range (XX:XX) puis la copier
- la coller en valeur sur le fichier B dans la page 3.

Voici le code que j'ai réalisé ( oui je suis conscient que y'a plus ergonomique mais n'ayant jamais touché au VBA j'étais plutot content :p)

Nb : il est très important de respecter les plages de cellules, en effet sous ses plages se trouve des formules ayant pour but de recouper les données copié dans la nouvelle page.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 ]Sub Macro2() ' Workbooks.Open Filename:="C:\Users\agut\Desktop\DataEpos\Epos All" Workbooks.Open Filename:="C:\Users\agut\Desktop\DataEpos\Epos Am" Workbooks.Open Filename:="C:\Users\agut\Desktop\DataEpos\Epos Cd" Workbooks("Epos Allobebe").Activate Sheets("Cost Detail").Activate Range("A1:CD150").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:CD150").Select Selection.Copy Workbooks("MACRO12345(2)").Activate Sheets("Allobebe Cost").Activate Range("A1:DT150").ClearFormats Range("A1").Select ActiveSheet.Paste Workbooks("Epos Allobebe").Activate Sheets("Vol Detail").Activate Range("A1:CD150").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:CD150").Select Selection.Copy Workbooks("MACRO12345(2)").Activate Sheets("AlloBEBE Vol").Activate Range("A1:DT150").ClearFormats Range("A1").Select ActiveSheet.Paste Workbooks("Epos Cdiscount").Activate Sheets("Cost Detail").Activate Range("A1:DT199").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:CD199").Select Selection.Copy Workbooks("MACRO12345(2)").Activate Sheets("CD Cost").Activate Range("A1:DT199").ClearFormats Range("A1").Select ActiveSheet.Paste Workbooks("Epos Cdiscount").Activate Sheets("Vol Detail").Activate Range("A1:DT199").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:CD199").Select Selection.Copy Workbooks("MACRO12345(2)").Activate Sheets("CD Vol").Activate Range("A1:FM199").ClearFormats Range("A1").Select ActiveSheet.Paste Workbooks("Epos Amazon").Activate Sheets("Vol Detail").Activate Range("A1:DT220").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:DT220").Select Selection.Copy Workbooks("MACRO12345(2)").Activate Sheets("AMZ Vol").Activate Range("A1:JX220").ClearFormats Range("A1").Select ActiveSheet.Paste Workbooks("Epos Amazon").Activate Sheets("Cost Detail").Activate Range("A1:DT220").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:DT220").Select Selection.Copy Workbooks("MACRO12345(2)").Activate Sheets("AMZ Cost").Activate Range("A1:JX220").ClearFormats Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks("Epos Cdiscount").Close False Workbooks("Epos Amazon").Close False Workbooks("Epos Allobebe").Close False MsgBox "Les données des Epos ont été mis à jour!" End Sub
Merci d'avance pour votre aide

Bonjour,

Il est de bon usage, après l'utilisation de l'enregistreur de macros, de modifier manuellement le code afin d'éviter autant que possible les appels à des sélection ou des activations.
Vous pourriez par exemple définir la subroutine suivante :

Code:

1
2
3
4
5
6
7
8
Sub DoCopyWork(WrkBk As String, Sht1 As String, Sht2 As String, Rng1 As String, Rng2 As String, Rng3 As String)
    With Workbooks(WrkBk).Sheets(Sht1)
        .Range(Rng1).Copy
        .Range(Rng1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Workbooks("MACRO12345(2)").Sheets(Sht2).Range(Rng2).ClearFormats
        .Range(Rng3).Copy Workbooks("MACRO12345(2)").Sheets(Sht2).Range("A1")
    End With
End Sub

Puis l'utiliser comme suit :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Macro2()
    Workbooks.Open Filename:="C:\Users\agut\Desktop\DataEpos\Epos All"
    Workbooks.Open Filename:="C:\Users\agut\Desktop\DataEpos\Epos Am"
    Workbooks.Open Filename:="C:\Users\agut\Desktop\DataEpos\Epos Cd"
    Call DoCopyWork("Epos Allobebe", "Cost Detail", "Allobebe Cost", "A1:CD150", "A1:DT150", "A1:CD150")
    <...>
    Application.CutCopyMode = False
    Workbooks("Epos Cdiscount").Close False
    Workbooks("Epos Amazon").Close False
    Workbooks("Epos Allobebe").Close False
    MsgBox "Les données des Epos ont été mis à jour!"
End Sub

Citation:

Envoyé par kroxs

Le problème est qu'il me faut la copie en valeur

Bonjour,

un exemple parmi les nombreux disponibles dans les discussions de ce forum …

___________________________________________________________________________________________________________
Je suis Paris, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …