Copier/coller différents fichiers dans un même classeur

Résolu/Fermé

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015 - 30 juil. 2014 à 15:56
caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015 - 1 août 2014 à 15:11

Bonjour et merci d'avance de votre temps pour me donner un coup de main sur cette macro !!!
:)))

Alors voila chaque mois je recois une dizaine de fichier avec le même onglet "Project"
Je souhaite faire une macro qui ira chercher tous ces fichiers qui sont dans le dossier "test macro"
Faire un copier (valeur) de chaque onglet "Project" de A7 à la colonne I jusqu'à l'avant dernière ligne remplie (car derniere ligne c'est la ligne total)
Et les coller à la suite dans ma feuille "Macro3"

Pouvez vous m'aider svp!!? ce serait super gentil!!!!!
Voici ma macro:

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
Dim i As Integer

'Chemin = répertoire choisi
Chemin = "X:\TP\BEBF\BRUS\$DATA\DPT-ACCOUNTING\CONSO-Magnitude\1 Analyses et productions\Capex\2014\2014 06\test macro\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xlsx*")

'Colonne = n° de colonne ou on va coller les données
Colonne = 1
'on boucle sur tous les fichiers excel du répertoire choisi
Do While Len(fichier) > 0
Colonne = Colonne + 1

Workbooks.Open Filename:=Chemin & fichier

Sheets("Project").Range("A7:J10").Copy
ActiveWorkbook.Close False

ThisWorkbook.Activate

'je bloque à ce niveau:
For i = 14 To 65536 Step 99
If Sheets("Feuil1").Cells(i, 2) = "" Then Exit For
Next
Sheets("Feuil1").Cells(i - 8, 1).Select
ActiveSheet.Paste

fichier = Dir()
Loop
End Sub

Un grand merci d'avance !!!
Caroline

A voir également:

Copier/coller différents fichiers dans un même classeur
Copier coller pdf - Guide
Wetransfer gratuit fichiers lourd - Guide
Renommer plusieurs fichiers en même temps - Guide
Copier une vidéo youtube - Guide
Comment réduire la taille d'un fichier - Guide

16 réponses

Réponse 1 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
30 juil. 2014 à 16:12

Bonjour,

For i = 14 To 65536 Step 99 pourquoi par pas de 99 ???? Mais y plus simple

A7 à la colonne I jusqu'à l'avant dernière ligne
et
ensuite
Sheets("Project").Range("A7:J10").Copy Vous connaissez l'avant derniere ligne et la colonne J que vient-elle faire ici????

Réponse 2 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
Modifié par caroline.bor le 30/07/2014 à 16:59

Je ne connais pas l'avant derniere ligne car ça depend de chaque fichier (j'ai juste écrit qque chose pour tester)
et oui je veux copier de la colonne A à H à partir de la ligne 7, jusque l'avant derniere ligne non vide !!..

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
Dim i As Integer

'Chemin = répertoire choisi
Chemin = "X:\TP\BEBF\BRUS\$DATA\DPT-ACCOUNTING\CONSO-Magnitude\1 Analyses et productions\Capex\2014\2014 06\test macro\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xlsx*")

'Colonne = n° de colonne ou on va coller les données
Colonne = 1
'on boucle sur tous les fichiers excel du répertoire choisi
Do While Len(fichier) > 0
Colonne = Colonne + 1

Workbooks.Open Filename:=Chemin & fichier

'jusque l'avant derniere ligne non vide
Sheets("Project").Range("A7:H10").Copy
ActiveWorkbook.Close False

ThisWorkbook.Activate

'je bloque à ce niveau (j'avoue ne pas trop savoir utiliser le for i ^^):
For i = 14 To 200 Step 1
If Sheets("Feuil1").Cells(i, 2) = "" Then Exit For
Next
Sheets("Feuil1").Cells(i - 8, 1).Select
ActiveSheet.Paste

fichier = Dir()
Loop
End Sub

Merciiii de ton aide!!

Réponse 3 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
30 juil. 2014 à 16:26

Re,

Je dois avoir un fichier du meme genre, je regarde la chose. Colonnes A a H cette fois-ci !!!!!

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
30 juil. 2014 à 16:44

colonne a à H dernier mot !! ;)

Réponse 4 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
30 juil. 2014 à 16:43

Ce serait toppppp, j'attend ton msg alors !!!!

Merciiiii !!!

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
30 juil. 2014 à 17:38

Re,

une facon de faire:

Sub Import()
    Dim Chemin As String, fichier As String
    Dim T_Infos, Ft
    Dim Ce_Classeur As String
    'fige ecran
    Application.ScreenUpdating = False
    
    Ce_Classeur = ThisWorkbook.Name
    'Chemin = répertoire choisi
    Chemin = "X:\TP\BEBF\BRUS\$DATA\DPT-ACCOUNTING\CONSO-Magnitude\1 Analyses et productions\Capex\2014\2014 06\test macro\"
    'Chemin = "D:\_atest\"
    'Choix du 1er fichier: a vous d'adapter
    fichier = Dir(Chemin & "Test*.xlsx")
    'on boucle sur tous les fichiers excel du répertoire choisi
    Do While fichier <> ""
        Workbooks.Open Filename:=Chemin & fichier
        With Sheets("Project")
            'avant derniere ligne
            derlig = .Range("A" & Rows.Count).End(xlUp).Row - 1
            'mise en memoire Infos
            T_Infos = .Range("A7:H" & derlig)
        End With
        'fermeture fichier
        ActiveWorkbook.Close False
        'fin tableau-1
        Ft = UBound(T_Infos) - 1
        'ecriture des infos
        With Worksheets("feuil1")
            'premiere ligne vide
            derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & derlig & ":H" & derlig + Ft) = T_Infos
        End With
        'fichier suivant
        fichier = Dir()
    Loop
    'defige ecran
    Application.ScreenUpdating = False
End Sub

Réponse 6 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
30 juil. 2014 à 17:50

Déja ça m'avance bien merci c'est top !!!

Encore un petit souci, mais je te joins un des fichiers que je recois pour que ce soit plus clair:
de A7 a H10 les données que je veux copier (toujours sous la même forme)

mais en dessous les personnes m'envoient également des commentaires/ notes que je ne veux pas prendre en compte dans mon copier coller..
Est t il possible de faire la selection jusqu'a la premiere cellule vide ds la colonne A?

Je ne sais pas si je suis très claire^^

Merci encore en tout casss c'est déja toppp!!

Réponse 7 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
30 juil. 2014 à 17:56

Re,

Je ne sais pas si je suis très claire Si, ca roule. je regarde la chose

A+

Réponse 8 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
30 juil. 2014 à 18:13

Re,

devrait aller:

Sub Import()
    Dim Chemin As String, fichier As String
    Dim T_Infos, Ft
    'fige ecran
    Application.ScreenUpdating = False
    'Chemin = répertoire choisi
    Chemin = "X:\TP\BEBF\BRUS\$DATA\DPT-ACCOUNTING\CONSO-Magnitude\1 Analyses et productions\Capex\2014\2014 06\test macro\"
    'Chemin = "D:\_atest\"
    'Choix du 1er fichier: a vous d'adapter
    fichier = Dir(Chemin & "Test*.xlsx")
    'on boucle sur tous les fichiers excel du répertoire choisi
    Do While fichier <> ""
        Workbooks.Open Filename:=Chemin & fichier
        With Sheets("Project")
            'avant derniere ligne
            Vide = ""
            lig = 7
            lig = .Columns("A").Find(Vide, .Cells(lig, "A"), , xlWhole).Row - 1
            'mise en memoire Infos
            T_Infos = .Range("A7:H" & lig)
        End With
        'fermeture fichier
        ActiveWorkbook.Close False
        'fin tableau-1
        Ft = UBound(T_Infos) - 1
        'ecriture des infos
        With Worksheets("feuil1")
            'premiere ligne vide
            derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & derlig & ":H" & derlig + Ft) = T_Infos
        End With
        'fichier suivant
        fichier = Dir()
    Loop
    'defige ecran
    Application.ScreenUpdating = False
End Sub

Réponse 9 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
30 juil. 2014 à 18:25

Alors la chapeau!!! t'es formidable !!!! merci de ton temps !!!

Dernière petite chose et après je ne t'embete plusss
En executant la macro je me rends compte d'un dernier pb car je vois qu'il manque des lignes:
En effet sur certains fichiers il y a des sous totaux:

Du coup le copier ne prend que le premier pavé

Est-il possible de soit supprimer les lignes ou il y a une case jaune?
ou bien de supprimer les lignes ou il y a SUM:?
par exemple...

Je te promets c'est la dernière ^^

Merci merci merciiii

Réponse 10 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 30/07/2014 à 19:30

Re,

serait-il possible d'avoir un des ces fichiers avec ces cases jaunes ou sous-totaux ??

Ou bien y a t-il un texte qui permettrait d'avoir la fin de votre tableau et ensuite je pourrais enlever les lignes a case jaune

Réponse 11 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
31 juil. 2014 à 09:27

Hello ;)

Comment puis-je t'envoyer le fichier? car via ce message je n'y arrive pas?

Réponse 12 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
31 juil. 2014 à 09:33

Bonjour,

pour mettre un fichier a dispo, click sur le lien suivant: https://www.cjoint.com/

Ne pas oublier de copier/coller le lien cree dans votre prochain message

A+

Réponse 13 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
31 juil. 2014 à 09:40

https://www.cjoint.com/?3GFjNtcn8fT

et voila :)

Réponse 14 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
31 juil. 2014 à 11:29

Re,

Je recupere le fichier et vous tiens au courant.

A+

Réponse 15 / 16

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
31 juil. 2014 à 12:26

Re,

Ceci devrait aller: https://www.cjoint.com/c/DGFmz28YxcN

Réponse 16 / 16

caroline.bor Messages postés 23 Date d'inscription mercredi 30 juillet 2014 Statut Membre Dernière intervention 12 novembre 2015
1 août 2014 à 15:11

Un grand merci c'est super!!

Bonne continuation !!

Discussions similaires

Dessiner avec son clavier et avec des lettres

Question PIX

Comment faire le signe de croix (chrétiens) ?

Excel formule : compter le nombre de valeurs différentes

Extraire le contenu de plusieurs fichiers

Discussions similaires

Newsletters