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

[Résolu/Fermé]
Signaler
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015
-
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015
-
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

16 réponses

Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
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????
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

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!!
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
Re,

Je dois avoir un fichier du meme genre, je regarde la chose. Colonnes A a H cette fois-ci !!!!!
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

colonne a à H dernier mot !! ;)
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

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

Merciiiii !!!
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
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
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

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!!
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
Re,

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

A+
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
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
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

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
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
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
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

Hello ;)

Comment puis-je t'envoyer le fichier? car via ce message je n'y arrive pas?
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
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+
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
Re,

Je recupere le fichier et vous tiens au courant.

A+
Messages postés
16052
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 octobre 2021
1 552
Re,

Ceci devrait aller: https://www.cjoint.com/c/DGFmz28YxcN
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

Un grand merci c'est super!!

Bonne continuation !!