Copie de fichiers vers un autre fichier

Le 24/07/2017 à 22:41

Bonjour, j'aimerais créer une macro qui me permet de copier toutes les lignes de nombreux fichiers 1 vers un autre fichier 2

Je précise que tous les fichiers 1 suivent le même modèle et que j'aimerais copier toutes les lignes sur le fichier 2

Concernant le fichier 2, il comporte un tableau nommé Tableau1

Dim wb As Workbook
For Each wb In Workbooks
        If wb.Name Like "Fichier1*" Then 
        'Calculer le numéro de la dernière ligne non vide
        'Copier les lignes de 2 à numéro de la derniere ligne non vide dans Tableau1
    Next wb1

J'ai pensé à une structure ressemblant à celle-ci mais je n'ai pas trop su comment l'écrire. Et j'avais aussi une question. Quand on passe d'un fichier 1 à un autre fichier 1 et qu'on colle les lignes de l'autre fichier 1, est ce qu'on colle bien ces lignes en dessous des lignes du premier fichier 1 ? C'est à dire est ce qu'on ne supprime pas les précédentes ?

Merci pour toute aide!

14fichier1.xlsx (7.97 Ko)
16fichier2.xlsx (8.71 Ko)
Le 24/07/2017 à 23:14

Bonsoir Supreme, bonsoir le forum,

Le code ci-dessous est à placer dans le fichier2 qui, par conséquent sera enregistré sous avec l'extension .xlsm puisqu'il contiendra une macro.

Pour qu'il fonctionne il faut que le fichier2 soit placé dans le même dossier que tous les fichiers1 !...

Il suffira d'ouvrir uniquement le fichier2 et de lancer la macro. Les fichiers1 seront ouverts les uns après les autres, leurs données seront copiées/collées dans la fichier2 puis le fichier1 sera refermé et la boucle passera au fichier1 suivant...

Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
'définit le premier fichier excel du dossier ayant CA comme chemin d'accès dont le nom commence par "Fichier1"
F = Dir(CA & "Fichier1*.xlsx")
Do While F <> "" 'exécute tant qu'il existe des fichiers F
    Workbooks.Open (CA & F) 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Worksheets(1) 'définit l'onglet source OS
    DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
    'définit la cellue de destination DEST (A2 si A2 est vide, sinon la première cellue vide de la colonne A de l'onglet OD
    Set DEST = IIf(OD.Range("A2").Value = "", OD.Range("A2"), OD.Range("A1").End(xlDown).Offset(1, 0))
    OS.Range("A2:D" & DL).Copy DEST 'copie la plage A2:D... (jusqu'à DL) et la colle dans DEST
    CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain  fichier excel du dossier ayant CA comme chemin d'accès dont le nom commence par "Fichier1"
Loop 'boucle
End Sub
Le 24/07/2017 à 23:36

Bonsoir ThauTheme

Merci infiniment pour votre code, je vais m'inspirer de celui-ci !

Mais les fichiers 1 ne sont dans le même dossier que le fichier 2. En fait, je télécharge ces fichiers 1 sur une application et le seul point commun est qu'ils commencent par fichier1

Du coup, ce que je voulais faire, c'etait d'ouvrir tout d'abord les fichiers1 puis de les traiter

Le 25/07/2017 à 09:54

Re,

Alors essaie comme ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CL As Workbook 'déclare la variable CL (Classeur)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
For Each CL In Workbooks 'boucle sur tous les classeurs ouverts
    If CL.Name Like "Fichier1*" Then 'condition : si le nom du fichier commence par "Fichier1"
        Set CS = CL 'définit le classeur source CS
        Set OS = CS.Worksheets(1) 'définit l'onglet source OS
        DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
        'définit la cellue de destination DEST (A2 si A2 est vide, sinon la première cellue vide de la colonne A de l'onglet OD
        Set DEST = IIf(OD.Range("A2").Value = "", OD.Range("A2"), OD.Range("A1").End(xlDown).Offset(1, 0))
        OS.Range("A2:D" & DL).Copy DEST 'copie la plage A2:D... (jusqu'à DL) et la colle dans DEST
        CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
Next CL 'prochain classeur de la boucle
End Sub
Le 25/07/2017 à 10:14

Merci, ça marche formidablement bien !

Juste une derniere petite question : dans le fichier source, j'aimerais que quand je lance ma macro, dans le fichier2, on commence par d'abord supprimer toutes les lignes de la 2eme à la derniere non vide (juste entre la colonne A et D)

Du coup, je pensais reprendre la même méthode Cells(Application.Rows.Count, "A").End(xlUp).Row

Ou il existe une autre méthode plus efficace ?

Le 25/07/2017 à 10:28

Re,

C'est une des bonne méthode. Je te propose aussi :

OD.Range("A1").CurrentRegion.Offset(1, 0).EntireRow.Delete 'efface les anciennes données de l'onglet OD

qui fait le job efficacement même si elle efface une ligne en plus en-dessous du tableau

Le code complet :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CL As Workbook 'déclare la variable CL (Classeur)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.Offset(1, 0).EntireRow.Delete 'efface les anciennes données de l'onglet OD
For Each CL In Workbooks 'boucle sur tous les classeurs ouverts
    If CL.Name Like "Fichier1*" Then 'condition : si le nom du fichier commence par "Fichier1"
        Set CS = CL 'définit le classeur source CS
        Set OS = CS.Worksheets(1) 'définit l'onglet source OS
        DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
        'définit la cellue de destination DEST (A2 si A2 est vide, sinon la première cellue vide de la colonne A de l'onglet OD
        Set DEST = IIf(OD.Range("A2").Value = "", OD.Range("A2"), OD.Range("A1").End(xlDown).Offset(1, 0))
        OS.Range("A2:D" & DL).Copy DEST 'copie la plage A2:D... (jusqu'à DL) et la colle dans DEST
        CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
Next CL 'prochain classeur de la boucle
End Sub
Rechercher des sujets similaires à "copie fichiers fichier"