Copier la meme cellule de plusieurs classeur dans un autre

Résolu
Mistral_13200 Messages postés 649 Statut Membre -  
Mistral_13200 Messages postés 649 Statut Membre -
Bonsoir à tous,

Je voudrais copier la même cellule d’une trentaine de classeurs dans une colonne d’un autre classeur.
J’ai une trentaine de classeurs, tous identiques, avec un seul onglet et tous situés dans le même répertoire. Je voudrais, avec une macro, copier la cellule «F60» de tous les classeurs dans la colonne «A» du classeur contenant la macro.

D’avance merci pour votre aide.
Mistral

3 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    Tous les classeurs sont dans le même dossier y compris celui qui contient la macro: 

    Sub boucle()
Dim fso As Object, dossier As Object, fichier As Object
Dim W1 As Workbook, wb As Workbook
Dim Derligne As Integer
Set W1 = Workbooks(ThisWorkbook.Name) 'classeur reception
Derligne = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1 '1ère ligne vide classeur reception
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(ThisWorkbook.Path) 'chemin dossier classeur
On Error Resume Next
Application.ScreenUpdating = False
For Each fichier In dossier.Files
    If fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name Then 'chemin classeur reception
    Else
    Set wb = Workbooks.Open(fichier)
         W1.ActiveSheet.Range("A" & Derligne).Value = wb.ActiveSheet.Range("F60").Value
        wb.Close
        Derligne = Derligne + 1
        End If
Next fichier
Application.ScreenUpdating = True
End Sub


    voilà

    0
  2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour,

    Sans ouvrir les 30 classeurs: confort des yeux, rapidité

    Dossier des sources différents du dossier de la macro XL4 dite de "Walkenbach"
    le dossier "source" comporte tous les fichiers "source"et seulement eux 

    Sub transferer()
    Dim lig As Long
    Dim recap As String, chemin As String, onglet As String
    Dim fich As String

    recap = ThisWorkbook.Name
    onglet = "feuil1" ' A ADAPTER
    chemin = "C:/......." 'CHEMIN COMPLET DU REPERTOIRE SOURCE ?
    Application.ScreenUpdating = False
    Range("A2:A1000").ClearContents
    lig = 2

    ChDir chemin
    fich = Dir("*.xls*")
    While fich <> ""
        If fich <> recap Then
                  Cells(lig, 1) = ExecuteExcel4Macro("'" & chemin & "\[" & fich & "]" & onglet & "'!R60C6")  'R60C6<==> F60
        lig = lig + 1
        End If
        fich = Dir
    Wend

    MsgBox "récapitulatif  terminé avec succès"
    End Sub


    Edit 12:00H

    Petite démo (1seul dossier sources et cible)
    https://mon-partage.fr/f/wPox5ag3/

    0
  3. Mistral_13200 Messages postés 649 Statut Membre 4
     
    Bonjour à vous deux, Le Pivert & Michel_M

    Un grand merci à vous deux pour vos réponses.
    J'ai testé les deux options et le deux fonctionne.
    Mais je vais garder celle de Michelle qui est beaucoup plus rapide.
    C'est d'autant plus vrai que je l'ai adaptée pour créer un tableau de quatre colonnes issu des trente fichiers.

    Mille mercis à vous deux.
    Mistral
    0