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

Résolu

caroline.bor Messages postés 23 Date d'inscription Statut Membre Dernière intervention -
caroline.bor Messages postés 23 Date d'inscription Statut Membre Dernière intervention - 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

Afficher la suite

A voir également:

Copier/coller différents fichiers dans un même classeur
Retrouver un copier-coller android - Guide
Copier coller pdf - Guide
Copier-coller - Accueil - Informatique
Renommer plusieurs fichiers en même temps - Guide
Comment réduire la taille d'un fichier - Guide

16 réponses

Réponse 1 / 16

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 Statut Membre Dernière intervention

colonne a à H dernier mot !! ;)

Réponse 4 / 16

caroline.bor Messages postés 23 Date d'inscription Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 Statut Membre Dernière intervention

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 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 Statut Membre Dernière intervention

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

et voila :)

Réponse 14 / 16

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Je recupere le fichier et vous tiens au courant.

A+

Réponse 15 / 16

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

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

Réponse 16 / 16

caroline.bor Messages postés 23 Date d'inscription Statut Membre Dernière intervention

Un grand merci c'est super!!

Bonne continuation !!

Discussions similaires

dessin avec symbole clavier

dessin au clavier cannabis

Votre réponse

Discussions similaires