récupérer la valeur d'une cellule dans plusieurs classeurs

récupérer la valeur d'une cellule dans plusieurs classeurs - VB/VBA/VBS - Programmation

Marsh Posté le 09-08-2012 à 17:17:39    

Bonjour à tous,  
Merci d'avance de m'accorder un peu de votre temps, pour m'aider à résoudre mon problème.
 
Je vous solicite car je voudrais récupérer la valeur d'une cellule dans plusieurs classeurs identiques sauf le nom qui change.  
Je voudrais donc copier ces valeurs situées dans les cellules "F12" des feuilles "Cover Page CAA" de chaque classeurq afin de coller toutes ces valeurs dans un fichier "test_list2" dans la feuille "Listes_Devis" à partir de la cellule "D13".
 
Voilà le début du code mais sa marche pas :s, où est mon erreur.

Code :
  1. Sub test()
  3. Dim objFSO, objDossier
  4. Dim mWbk As Excel.Workbook
  7. Set objFSO = CreateObject("Scripting.FileSystemObject" )
  8. Set objDossier = objFSO.GetFolder("D:\totot\" )
  10. If (objDossier.Files.Count > 0) Then
  11. For Each objFichier In objDossier.Files
  12. If (InStr(1, objFichier.Name, ".xls", 1) > 0) Then
  14. Set mWbk = Excel.Workbooks.Open(objDossier.Path & "\" & objFichier.Name)
  16. mWbk.Worksheets("Cover page CAA" ).Range("F12" ).Value
  17. Workbook("test_list2" ).Worksheets("Liste_Devis" ).Range("D" & 13).End(xlUp)(2).Row.Paste
  19. mWbk.Close
  20. Set mWbk = Nothing
  21. End If
  22. Next
  23. End If
  26. End Sub


Merci d'avance de votre aide.

Reply

Marsh Posté le 09-08-2012 à 17:17:39   

Reply

Marsh Posté le 10-08-2012 à 10:17:40    

Ça ne marche pas où ?


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 10-08-2012 à 13:29:18    

Reply

Marsh Posté le 16-08-2012 à 10:19:52    

Merci, de votre aide.
j'ai la solution merci à Nad.
voici la solution :
 

Code :
  1. Sub Transferer()
  2. Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
  3. Application.ScreenUpdating = False
  4. Application.DisplayAlerts = True
  6. DerLg = Range("D65536" ).End(xlUp).Row + 1
  7. Range("D13:D" & DerLg).Delete
  9. Chemin = ThisWorkbook.Path
  10. FName = Dir(Chemin & "\" & "*.xls" )
  11. Set dossier = CreateObject("Scripting.FileSystemObject" ).GetFolder(Chemin)
  12. Lg = 13
  14. For Each Fichier In dossier.Files   
  15. NomFichier = Fichier.Name
  16. If Not Fichier.Name = "test_list2.xls" Then
  17. Workbooks.Open Filename:=Chemin & "/" & NomFichier
  19. On Error Resume Next
  20.        
  21. With Workbooks(NomFichier)
  22. .Sheets("Cover Page CAA" ).Range("F12" ).Copy ThisWorkbook.Sheets("Listes_Devis" ).Range("D" & Lg)
  23. .Close
  25. Lg = Lg + 1
  27. End With
  28. End If
  30. Next
  32. End Sub


 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed