Copie d'une même colone dans plusieurs fichiers à coller

Bonjour à tous,

Je vous explique rapidement mon besoin j'ai une cinquantaine de fichiers excel dans un répertoire et j'aimerais que dans un premier temps je puisse copier pour chaque fichier la colonne A d'un onglet spécifique qui aura toujours le même nom et la coller dans un autre fichier par colonne. A la fin je dois avoir 50 colonnes qui represente les colonnes A de mes 50 fichiers.

Dans un second temps mais c'est pas le plus urgent j'aimerais qu'on puisse mettre en en-tête de chaque colonne la cellule K1 du fichier correspondant à la colonne.

En esperant avoir été claire, n'hésitez pas à me demander plus d'explication je tacherais de vous les fournir.

Cordialement,

Dark Nel

Bonjour Darknel, bonjour le forum,

Code à placer dans le fichier destination qui doit lui-même se trouver dans le dossier contenant les fichiers source. Il te reste juste à adapter le noms des onglets que tu n'as pas spécifié dans tes explications :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)

Set CD = ThisWorkbook 'définit le classeur destination CD
CA = ThisWorkbook.Path & "\" 'définit le chemin d'accès CA
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (ici le premier onglet du classeur destination, tu adapteras si nécessaire)
F = Dir(CA & "*.xlsx") 'définit le premier fichier excel F du dossier ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des fichiers F
    If F <> CD.Name Then 'condition : si le fichier F n'est pas le classeur destination
        Workbooks.Open (CA & F) 'ouvre le fichier F
        Set CS = ActiveWorkbook 'définit la classeur source CS
        Set OS = CS.Worksheets(1) 'définit l'onglet source (tu adapteras a ton cas)
        'de'finit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la ligne 1 de l'onglet OD)
        Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1))
        DEST.Value = OS.Range("K1").Value 'renvoie la valeur de K1 de l'onglet source dans DEST
        DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet source
        OS.Range("A1:A" & DL).Copy DEST.Offset(1, 0) 'copy la plage éditée de la colonne A dans DEST décalée d'une ligne vers le bas
        CS.Close SaveChanges:=False 'ferme le classeur source (sans enregistrer)
    End If 'fin de la condition
    F = Dir 'définit le prochain fichier excel F du dossier ayant CA comme chemin d'accès
Loop 'boucle
End Sub

Bonjour,

Oups .. j'allais remettre l'excellent code de Tauthème (que je salue) adapté mais j'ai été trop lent

P.

Merci,

Je vais m'y atteler cet après-midi, je vous tiens au courant de l'évolution.

Cordialement,

Dark Nel

C'est nickel pour moi j'ai du un peu adapter mais c'était léger jai juste fait le coller à 0, 0 et ensuite j'ai coller la valeur K1 c'est juste une histoire de formatage vu que j'utilise une autre macro.

Encore une fois mille merci pour votre aide et la rapidité.

Cordialement,

Dark Nel