Macro Excel

[RW02]

Bonjour,
Dans le cadre de mes activités professionnelles, je reçois toutes les semaines une douzaine de classeurs Excel. Je dois en extraire des données pour les regrouper dans un classeur de synthèse.
Chaque classeur est identique en terme de structure (onglets avec mêmes noms). Aujourd'hui, j'ouvre un premier classeur, je vais dans l'onglet 1 et je copie/colle les lignes 7 à la dernière sur mon classeur de synthèse. Puis je passe au classeur suivant. C'est long, fastidieux et source d'erreurs.
Est-il possible d'automatiser cela à l'aide d'une macro? Les classeurs sont tous dans le même dossier et ont le même nom chaque semaine. Par contre, le classeur de synthèse sera renommé différemment.
Ce n'est pas simple à expliquer. J'espère avoir été suffisamment clair !
Je précise que je ne connais pas grand chose en langage macro.
Merci d'avance pour vos conseils.
Cordialement,
Régis

 

[thebenoit59]

Re : Macro Excel

Bonjour Régis, bienvenue sur le forum.

Il est tout a fait possible d'automatiser ta tâche par macro.
Mais sans fichiers nous ne pourrons pas vraiment t'apporter d'aide.
Pourrais-tu fournir un fichier de Synthèse et un voir deux fichiers sources.
Supprime les données confidentielles évidemment.

 

[RW02]

Re : Macro Excel

Bonjour Thebenoit59 (tu es du Nord ?)
Merci d'avoir répondu si vite et de me proposer ton aide.
Voici les fichiers !!!
Je précise qu'il faut copier les lignes à partir de la L6 et uniquement celles qui ont une valeur (texte) en colonne D. Dans la synthèse, il faut compiler l'ensemble des lignes des 3 fichiers et pour chaque onglet.

 

[RW02]

Re : Macro Excel

Bonjour à tous,
Je me permets de vous relancer sur le sujet qui me préoccupe. Je ne veux pas paraître insistant mais si vous pouviez au moins me donner quelques pistes de réflexion, ce serait vraiment sympa...
Bien cordialement, Régis

 

[Marc L]

Bonjour,

attendu que le classeur synthèse est vide,
une explication claire & exhaustive s'avère plus que nécessaire …
​

_______________________________________________________________________________
​

Je suis Paris, Charlie, Bruxelles, …

​

 

[thebenoit59]

Re : Macro Excel

Bonjour Régis, bonjour Marc.

Je te joins le fichier de Synthèse seulement, les autres n'auront pas d'utilité.
Je suis parti sur le fait que tes fichiers se situent à la même racine.

Je n'ai pas désactivé, volontairement, l'actualisation de l'écran pour que tu rendes compte de la boucle.

J'ai ajouté en fin de procédure une numérotation de tes lignes.

 

[XKF763]

Re : Macro Excel

Bonjour thebenoit59, et merci beaucoup pour ton aide.
Ta macro fonctionne parfaitement bien. Par contre, quand il n'y a pas de données en ligne 6, elle me reproduit la ligne 5 avec les intitulés de colonnes (voir fichier joint après utilisation de la macro) !!! Est-il possible d'y remédier ?
J'espère ne pas abuser de ton temps !
Bien cordialement, Régis

 

[thebenoit59]

Re : Macro Excel

Bonjour RW02 alias XKF763 (n'es-tu pas un droïde par hasard ?).

Alors je te propose la solution ci-dessous :
En gros, quand nous déterminons la variable "j" (dernière ligne dans la feuille à importer), nous vérifions qu'elle soit supérieure à 5 et réalisons le copier-coller.
Sinon nous passons à la suite du traitement.

Option Explicit

'RW02
'http://www.excel-downloads.com/forum/242796-macro-excel.html#post1561007

Sub Synthese_Fichiers()
Dim Chemin As String, Fichier As String, Synthese As String
Dim wSynthese As Workbook, wFichier As Workbook
Dim Feuilles
Dim i As Long, j As Long, c

'Définit le répertoire d'origine des fichiers (identique pour la synthèse et les autres)
Chemin = ThisWorkbook.Path
Fichier = Dir(Chemin & "\*.xlsx")
Synthese = ThisWorkbook.Name

'Définit la variable classeur
Set wSynthese = ThisWorkbook
Feuilles = Array("PQF1", "PQF2", "PQF3")

'Boucle sur tous les fichiers du répertoire
'On vérifie que le nom du fichier est différent de celui de synthèse
'Et que le fichier dispose bien d'un nom
Do While Fichier <> Synthese And Len(Fichier) > 0
    'On ouvre le fichier et on définit la variable
    Workbooks.Open (Chemin + "\" + Fichier): Set wFichier = ActiveWorkbook
        'On boucle chaque feuille du classeur
        For Each c In Feuilles
            'On définit la dernière ligne de chaque onglet
            i = wSynthese.Sheets(c).[b65000].End(xlUp).Row + 1 '+1 pour coller après la dernière ligne
            j = wFichier.Sheets(c).[b65000].End(xlUp).Row
                'On vérifie que la dernière ligne (j) soit supérieure à 5 et on copie colle les lignes
                'Sinon on passe à la prochaine étape
                If j > 5 Then wFichier.Sheets(c).Rows("6:" & j).Copy wSynthese.Sheets(c).Cells(i, "a")
        Next c
    'On ferme le classeur ouvert
    wFichier.Close False
    Fichier = Dir()
Loop

'A conserver si tu le souhaites seulement
With wSynthese
    For Each c In Feuilles
        j = 1
        For i = 6 To .Sheets(c).[a65000].End(xlUp).Row Step 2
            .Sheets(c).Cells(i, "a").Value = j
            j = j + 1
        Next i
    Next c
End With
End Sub

 

[XKF763]

Re : Macro Excel

Super, ça marche impeccablement bien !!!
Un grand MERCI à thebenoit59