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   -
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

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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????
    0
  2. 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!!
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    Je dois avoir un fichier du meme genre, je regarde la chose. Colonnes A a H cette fois-ci !!!!!
    0
    1. caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention  
       
      colonne a à H dernier mot !! ;)
      0
  4. caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention  
     
    Ce serait toppppp, j'attend ton msg alors !!!!

    Merciiiii !!!
    0

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

    Posez votre question
  6. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
  7. 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!!
    0
  8. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

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

    A+
    0
  9. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
  10. 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
    0
  11. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
  12. 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?
    0
  13. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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+
    0
  15. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    Je recupere le fichier et vous tiens au courant.

    A+
    0
  17. caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention  
     
    Un grand merci c'est super!!

    Bonne continuation !!
    0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses