Transferts de valeur d'un dossier vers un Excel

bonjour a tous

je viens vers vous car je suis une bille en vba .

j'aurai besoin de récupérer la case M2 et le résultat d une formule situer en N1 dont la valeur est de type horaire "00:00:00" de chaque classeur d'un même dossier et de la copier dans un classeur de ce même dossier sous une colonne C et D

C4 = M2 classeur 1 D4 = N1 classeur 1

C5 = M2 classeur 2 D4 = N1 classeur 2

le tous autant de fois que de classeur

le seul classeur non pris en compte seras celui ou sont copier les valeurs M2 et N1

j'avais commencé a essayer de modifier un vieux bout de code mais cela manque de commentaire

   
    Sub Transferer()
    Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
    DerLg = Range("D65536").End(xlUp).Row + 1
    Range("D3:D" & DerLg).Delete
    Chemin = ThisWorkbook.Path
    FName = Dir(Chemin & "\" & "*.xls")
    Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
    Lg = 3
    For Each Fichier In dossier.Files
    NomFichier = Fichier.Name
    If Not Fichier.Name = "Analytique OGP HEURE SUP.xls" Then
    Workbooks.Open Filename:=Chemin & "/" & NomFichier
    On Error Resume Next

    With Workbooks(NomFichier)
    .Sheets("Feuil1").Range("N1").Copy ThisWorkbook.Sheets("HEURE SUP").Range("D" & Lg)
    .Close
    Lg = Lg + 1
    End With
    End If
    Next
    End Sub

en espèrent que quelqu'un est un peut de temps pour m'aider;

merci d'avance

cordialement

PAGO82

up

bonjour voici ton code commenter et dont j'ai ajouter ce que tu voulais normalement

fred

Sub Transferer()
    Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
    'recupere la derniere ligne occupée en colonne D +1 de la feuille active moi je rajout le nom de l'onglet
    DerLg = Sheets("HEURE SUP").Range("D65536").End(xlUp).Row + 1
    'supprime les ligne de la colonne D => supprime les données existantes
    'Range("D3:D" & DerLg).Delete
    'je renplacerait par
    Range("C3:D" & DerLg).Delete
    'stock dans une variable le chemin qui permet d'acceder a ce documentt
    Chemin = ThisWorkbook.Path
    'regarde si des fichiers *.xls existent dans le dossier a priori ne sert pas ...
   ' FName = Dir(Chemin & "\" & "*.xls")
    'déclaration d'un objet type dossier
    Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
    'initialise ta variable pour les lignes ou seront stockée les info copiées des autres classeurs
    'on commence a ligne 3
    Lg = 3
    'on va parcourir parcourir tous les fichiers du dossier cela suppose que tous les fichiers sont de type xls
    For Each Fichier In dossier.Files
    'récupération du nom de fichier un par un
    NomFichier = Fichier.Name
    'vérification que ce n'est pas le fichier source ... ce fichier !!
    If Not NomFichier  = "Analytique OGP HEURE SUP.xls" Then
    'en cas d'erreur on passe a l'instruction suivante evite le plantage du code mais te dit rien, peut-etre "dangereux" car si le resultat n'est la le bon tu ne sais pas pourquoi mise a part faire drouler la macro manuellement...
    On Error Resume Next
    'ouverture du fichier
    Workbooks.Open Filename:=Chemin & "/" & NomFichier

    With Workbooks(NomFichier)
    ' cela supose que dans tous les fichiers l'onglet 'Feuil1' existe !!!!

    'copie de la cellule N1 de la feuille 'feuil1' du fichier qu'on vient d'ouvrir dans le fichier source onglet Heure SUP cellule D lig
    .Sheets("Feuil1").Range("N1").Copy ThisWorkbook.Sheets("HEURE SUP").Range("D" & Lg)
    'il faut mettre ici la deuxième cellule que tu veux copié dans la colonne C
    .Sheets("Feuil1").Range("M2").Copy ThisWorkbook.Sheets("HEURE SUP").Range("C" & Lg)
    'fermeture du fichier
    .Close
    'incrementation de la lig
    Lg = Lg + 1
    End With
    End If
    Next
    End Sub

merci beaucoup

cela répond exactement a mon attente

mais cela ne fonctionne pas juste la colonne D récupérant le résultat de la formule N1=O5+O17+O29+O41+O53+O65+O71 sur chaque classeur en Feuil1

résultat sur Analytique OGP HEURE SUP.xls colonne C parfait mais D a zero

C3 D3

20 0:00:00

C4 D4

21 0:00:00

deplus la formule est récupéré pas le résultat et elle ne correspond pas a celle de N1

formule en D3=E7+E19+E31+E43+E55+E67+E73

formule en D4=E8+E20+E32+E44+E56+E68+E74

je n'ai pas de formule de ce type en colonne E

si quelqu'un a une idée sur ce qui ce passe

bonsoir

c'est la valeur de la cellule qu'il faut recupérer ???

dans ce cas il faut remplacer

  'copie de la cellule N1 de la feuille 'feuil1' du fichier qu'on vient d'ouvrir dans le fichier source onglet Heure SUP cellule D lig
   .Sheets("Feuil1").Range("N1").Copy ThisWorkbook.Sheets("HEURE SUP").Range("D" & Lg)
    'il faut mettre ici la deuxième cellule que tu veux copié dans la colonne C
   .Sheets("Feuil1").Range("M2").Copy ThisWorkbook.Sheets("HEURE SUP").Range("C" & Lg)

par

   ThisWorkbook.Sheets("HEURE SUP").Range("D" & Lg) = .Sheets("Feuil1").Range("N1").value
    'il faut mettre ici la deuxième cellule que tu veux copié dans la colonne C
ThisWorkbook.Sheets("HEURE SUP").Range("C" & Lg) =   .Sheets("Feuil1").Range("M2").value 

fred