Résolu Macro pour récupérer la cellule B4 sur Plusieurs fichiers .xlsx vers un nouveau classeur.

WCastillo

Nouveau membre
Bonjour Chère communauté
je réalise actuellement un stage dans une société.
il m'as été accordé la tache de:
Élaborer une Macro qui permettrai de récupérer la cellule B4 sur Plusieurs fichiers .xlsx (2000) contenus dans un seul Dossier vers un nouveau classeur
je suis vraiment pas débutant sur de la programmation
(il me faut un bon temps d'analyse pour comprendre la logique du code)

en cherchant sur internet j'ai trouvé des bouts de code sur mon sujet
à présent j'arrive à ouvrir le classeur récepteur et un des fichier, avec un boucle, d'où on copie la cellule B4

mais j'ai une erreur sur la ligne qui copie la cellule
je vous met une capture de mon code

pourriez vous m'aider S'il vous plait
je vous remercie d'avance et peut mieux développer si je me suis pas bien fait comprendre

Code:
Option Explicit

Sub Macro1()

Dim FSO As Object

Dim file_fichierNT As Object



' // Quelques variables

Dim wb_maitre As Workbook

Dim wb_fichierNT As Workbook



Dim cells As Integer

'//cells = Workbooks(Selection.Value).Sheets(Selection.Value).Range("B4").Value



Set FSO = CreateObject("Scripting.FileSystemObject")

'// declare une variable pour la cellule A1





Set wb_maitre = Workbooks.Open("C:\Users\usertests\Documents\macro_excel\maitre\maitre.xlsx") ' // On ouvre le classeur maître





For Each file_fichierNT In FSO.GetFolder("C:\Users\usertests\Documents\macro_excel\").Files



' // On vérifie a priori que le fichier est un classeur (XLS)

If UCase(file_fichierNT.Name) Like "*.XLSX" Then



Set wb_fichierNT = Workbooks.Open(file_fichierNT.Path, ReadOnly:=True)



file_fichierNT.Worksheets("1").Activate.range("B4").Select.Copy After:=file_fichierNT





' // On ferme le classeur quesTP, sans rien enregistrer - euh, à quoi sert le readonly alors ???

wb_fichierNT.Close SaveChanges:=False





End If

Next



End Sub


Mercie de nouveau
cordialement Wcastillo
 
Dernière édition par un modérateur:

drul

Obscur pro du hardware
Staff
Salut, c'est pas trop mal il me semble, mais ton utilisation de copy est fausse,

Ce que je n'ai pas compris, c'est où est-ce que tu veux copier ta cellule B4 ???
Dans wb_maitre j'imagine, mais où plus précisément ?
 

WCastillo

Nouveau membre
Salut, c'est pas trop mal il me semble, mais ton utilisation de copy est fausse,

Ce que je n'ai pas compris, c'est où est-ce que tu veux copier ta cellule B4 ???
Dans wb_maitre j'imagine, mais où plus précisément ?


Bonjour Drul,
c'est ma première fois dans un forum, donc, heureux d'avoir ma première réponse sur mon sujet
je détaille un peu:
nous avons 2000 fichiers .xlsx (données de stagiaires qui se font former dans l'association où je réalise mon stage) tous dans un seul dossier

chaque fichier contient un numéro de téléphone dans la cellule B4, que je veux, plutôt, dois récupérer sur un nouveau fichier (dans la première feuil et colonne A du nouveau fichier, wb_maitre), excel ne fait pas vraiment partie de mes point forts.

merci encore pour ta réponse
 

WCastillo

Nouveau membre
j'ai essayé avec ceci mais tjrs pas
wb_fichierNT.Sheets("feuil1").Range("B4").Copy Destination:=wb_maitre.Sheet("feuil1").Range("A")
 

WCastillo

Nouveau membre
je tente des choses
mais toujours la même erreur
plus exactement à ce niveau
Worksheets(celsource).Copy Destination:=Sheets(ligVide)

Sub Macro1()
Dim FSO As Object
Dim file_fichierNT As Object

' // Quelques variables
Dim wb_maitre As Workbook
Dim wb_fichierNT As Workbook
Dim ws_maitre_der As Worksheet
Dim ligVide As Long
Dim celsource As String


Set FSO = CreateObject("Scripting.FileSystemObject")



Set wb_maitre = Workbooks.Open("C:\Users\usertests\Documents\macro_excel\maitre\maitre.xlsx") ' // On ouvre le classeur maître


For Each file_fichierNT In FSO.GetFolder("C:\Users\usertests\Documents\macro_excel\").Files

' // On vérifie a priori que le fichier est un classeur (XLS)
If UCase(file_fichierNT.Name) Like "*.XLSX" Then

' // On ouvre le classeur source en lecture seule
Set wb_fichierNT = Workbooks.Open(file_fichierNT.Path, ReadOnly:=True)

'// on se place à la dernière ligne en partant du haut pour coller dans le tableau recepteur
ligVide = wb_maitre.Sheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1


celsource = wb_fichierNT.Sheets("feuil1").Range("B4")


Worksheets(celsource).Copy Destination:=Sheets(ligVide)




' // On ferme le classeur quesTP, sans rien enregistrer - euh, à quoi sert le readonly alors ???
wb_fichierNT.Close SaveChanges:=False


End If
Next
End Sub

Merci d'avance
 

drul

Obscur pro du hardware
Staff
Meilleure réponse
J'arrive à ça:
Code:
Option Explicit

Sub Macro1()

Dim FSO As Object

Dim file_fichierNT As Object

' // Quelques variables

Dim wb_maitre As Workbook
Dim wb_fichierNT As Workbook
Dim cells As Integer
Dim target As Range

'//cells = Workbooks(Selection.Value).Sheets(Selection.Value).Range("B4").Value

Set FSO = CreateObject("Scripting.FileSystemObject")

'// declare une variable pour la cellule A1

Set wb_maitre = Workbooks.Open("C:\tst\maitre\maitre.xlsx") ' // On ouvre le classeur maître

Set target = wb_maitre.Sheets(1).[A1]

For Each file_fichierNT In FSO.GetFolder("C:\tst\").Files
    ' // On vérifie a priori que le fichier est un classeur (XLS)
    If UCase(file_fichierNT.name) Like "*.XLSX" And Not UCase(file_fichierNT.name) Like "*MAITRE.XLSX" Then
        Set wb_fichierNT = Workbooks.Open(file_fichierNT.Path, ReadOnly:=True)
        wb_fichierNT.Worksheets(1).Range("B4").Copy Destination:=target
        Set target = target.Offset(1, 0)
    ' // On ferme le classeur quesTP, sans rien enregistrer - euh, à quoi sert le readonly alors ???
        wb_fichierNT.Close
    End If
Next
End Sub
 

WCastillo

Nouveau membre
En fait rien de grave
double clique sur une de cellule et pfff... les numéros s'affiche merci Drul
Forum 5⭐
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 058
Membres
1 586 285
Dernier membre
LeFront
Partager cette page
Haut