Copier-coller entre deux fichiers

Le 13/04/2020 à 16:57

Bonjour,

Je fais appel à votre expertise en VBA.

Je possède un fichier avec des noms de valeurs (S&P 500) en colonne A et des notes (de -2 à 2, step de 0,5) attribuées pour tous les mois et pour chaque valeur.

Je cherche au travers de VBA seulement d'exporter (copier coller) dans un autre fichier ces données mais en supprimant les colonnes avec "#DIV/0!" (donc une colonne sur 2). Le fichier source se voit aggréger au fil du temps des nouvelles colonnes de données (avec des nouvelles notes) pour chaque nouveau mois. Je ne sais pas trop comment faire pour supprimer ces colonnes lors de l'export.

Voici un fichier avec dans l'onglet "Données" le fichier source, et dans l'onglet "Sortie" ce que j'aimerais avoir dans mon fichier d'export. Les deux fichiers se situent dans le même dossier et répertoire.

Merci beaucoup de votre aide!

14testnote.xlsx (112.77 Ko)
Le 13/04/2020 à 18:31

Bonjour Sidi, bonjour le forum,

Dans ta précipitation tu as oublié de nous donner le nom du classeur destination et celui de l'onglet qui recevra les données. Tu adapteras le code ci-dessous :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim NCD As String 'déclare la variable NCD (Nom Classeur Destination)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim I As Integer 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit la classeur source CS
Set OS = CS.Worksheets("Données") 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
NCD = "Test.xlsx" 'définit la nom du classeur destination NCD (à adapter à ton cas)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks(NCD) 'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CD = Workbooks.Open(CA & NCD) 'définit le classeur destination CD en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (ici le premier onglet du classeur destination, tu adapteras)
OD.Cells.ClearContents 'efface d'éventuelle ancienne données de l'onglet OD
OS.Range("A13").CurrentRegion.Copy OD.Range("A1") 'copie les données et les colle dans A1 de l'onglet OD
DC = OD.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit le dernière colonne éditée de la ligne 1 de l'onglet OD
For I = DC To 2 Step -1 'boucle inversée des colonnes DC à 2 par pas de -1
    'si la valeur de la celluile ligne 1 colonne I est une erreur, supprime la colonne
    If IsError(OD.Cells(1, I).Value) Then OD.Columns(I).Delete
Next I 'prochaien colonne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
CD.Save 'enregistre le classeur Destination
End Sub

Le fichier (qui est devenu xlsm puisqu'il contient la macro) :

17sidi-ep-v01.xlsm (102.09 Ko)
Le 13/04/2020 à 19:37

Bonjour ThauThème,

Merci beaucoup pour ta réponse rapide et les explications du code!

C'est exactement ce que je voulais mais je me suis mal exprimé, dans le sens où je ne veux pas exporter mais "importer"; C'est à dire que je veux lancer le code depuis le fichier de destination.

Et je suis pas sur de ce que fait le "Range("A13"). CurrentRegion" ? Il selectionne toute la plage, c'est ça? (c'est juste pour moi pour comprendre).

Merci énormément !

sidi13

9destination.xlsx (7.57 Ko)
Le 13/04/2020 à 20:22

Re,

Oui c'est ça, s'il n'y a aucune ligne entièrement vide ou colonne entièrement vide dans le tableau. C'est comme quand tu te places n'importe où dans le tableau et que tu combines les touches Ctrl + *...

Le code pour importer (tu ne fournis toujours pas les noms des fichiers/dossier )

Sub Macro1()
Dim CD As Workbook 'déclare la variable CS (Classeur Source)
Dim OD As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim NCD As String 'déclare la variable NCD (Nom Classeur Destination)
Dim CS As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim I As Integer 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur source CS
Set OD = CD.Worksheets("Sortie") 'définit l'onglet source OS
CA = CD.Path & "\" 'définit le chemin d'accès CA
NCD = "Test.xlsx" 'définit la nom du classeur destination NCD (à adapter à ton cas)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CS = Workbooks(NCD) 'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Workbooks.Open(CA & NCD) 'définit le classeur destination CD en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OS = CS.Worksheets(1) 'définit l'onglet destination OD (ici le premier onglet du classeur destination, tu adapteras)
OD.Cells.ClearContents 'efface d'éventuelle ancienne données de l'onglet OD
OS.Range("A13").CurrentRegion.Copy OD.Range("A1") 'copie les données et les colle dans A1 de l'onglet OD
DC = OD.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit le dernière colonne éditée de la ligne 1 de l'onglet OD
For I = DC To 2 Step -1 'boucle inversée des colonnes DC à 2 par pas de -1
    'si la valeur de la celluile ligne 1 colonne I est une erreur, supprime la colonne
    If IsError(OD.Cells(1, I).Value) Then OD.Columns(I).Delete
Next I 'prochaien colonne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
CD.Save 'enregistre le classeur Destination
End Sub
Le 13/04/2020 à 20:31

Merci beaucoup thautheme. Je viens de l'adapter à mes fichiers et tout fonctionne, incroyable !

Merci !

Le 14/04/2020 à 10:06

out va bien, merci!

Rechercher des sujets similaires à "copier coller entre deux fichiers"