Menu
Posez votre question Signaler

Copier la meme cellule de plusieurs classeur dans un autre [Résolu]

Messages postés
518
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
3 décembre 2019
 - - Dernière réponse : Mistral_13200
Messages postés
518
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
3 décembre 2019
 - 16 nov. 2019 à 09:45
Excel Posez votre question Signaler
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
Afficher la suite 

3 réponses

Signaler Commenter la réponse de cs_Le Pivert
Messages postés
6422
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
 420
0
Merci
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à

Commenter la réponse de cs_Le Pivert
Signaler Commenter la réponse de michel_m
Messages postés
16002
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
5 décembre 2019
 2833
0
Merci
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/

Commenter la réponse de michel_m
Signaler Commenter la réponse de Mistral_13200
Messages postés
518
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
3 décembre 2019
 3
0
Merci
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
Commenter la réponse de Mistral_13200
Répondre Posez votre question