Ouvrir plusieurs fichiers en vba

Ouvrir plusieurs fichiers en vba - VB/VBA/VBS - Programmation

Marsh Posté le 22-05-2014 à 13:16:14    

Bonjour à tous,
 
Je voudrai créer un programme qui puisse être capable d'aller chercher des infos dans plusieurs classeurs Excel (en fonction d'un n° de semaine choisi) puis, me coller ces infos dans un fichier commun ("MC_Commun" ).
 
Tous les classeurs se trouve dans le même dossier.
 
J'ai réussi avec un 1 fichier (MC_Shootage) mais, je ne sais pas comment gérer avec plusieurs fichiers ? Existe t'il une fonction multiFichier ou qqch comme ça?
 
 Voici mon pgm:
 

Code :
  1. Sub Dechet_Finition_Hebdo()
  3. 'Identification des chemins et des fichiers
  5.     Dim Chemin As String, WbDestination As Workbook, WbSource As Workbook
  6.     Dim Fichier As String
  7.     Dim Semaine As Long, L As Long, x As Long
  8.     Set WbDestination = ThisWorkbook
  9.     L = WbDestination.Worksheets("Donnees" ).Range("A65536" ).End(xlUp).Row + 1
  10.     WbDestination.Worksheets("Donnees" ).Range("A6:N" & L).ClearContents
  11.  
  12.      'Chemin = "X:\30_QUALITE\307_Gestion_de_service\Lyse\AAAA-Main-Courante-Atelier\Recherches pour MC_commun\MC_commun"
  13.     Chemin = ThisWorkbook.Path    'si les 2 fichiers dans même dossier
  14.    
  15.     'demande à l'utilisateur le numéro de semaine, semaine en cours par défaut
  16.     Semaine = InputBox("N° de la semaine", "SEMAINE", DatePart("ww", Date, vbMonday) - 1)
  17.     If Semaine = 0 Then Exit Sub
  18.     Fichier = "MC_Shootage.xlsm"
  19.     If FichierExiste(Chemin & "\" & Fichier) Then
  21.     'ouverture du fichier en lecture seule
  22.         Workbooks.Open Filename:=Chemin & "\" & Fichier, UpdateLinks:=0, ReadOnly:=True
  23.         Set WbSource = ActiveWorkbook
  24.         On Error Resume Next
  25.         x = Application.WorksheetFunction.CountIf(WbSource.Worksheets("Synthese" ).Range("B5:B1000" ), "=" & Semaine)
  26.             If x > 0 Then
  27.         With WbSource.Worksheets("Synthese" )
  28.                 'Transfert des données
  29.                 'exemple pour ajout de ligne(s)
  30.                 For Each cel In .Range("B6:B1000" )
  31.                     If cel = Semaine Then
  32.                         L = WbDestination.Worksheets("Donnees" ).Range("A65536" ).End(xlUp).Row + 1
  33.                          .Range("A" & cel.Row & ":N" & cel.Row).Copy Destination:=WbDestination.Worksheets("Donnees" ).Range("A" & L)
  34.                     End If
  35.                 Next cel
  36.         End With
  38.         WbSource.Close SaveChanges:=False
  39.             Else
  40.         WbSource.Close SaveChanges:=False
  41.             End If
  42.       End If
  43. End Sub
  45. Function FichierExiste(NomFichier As String) As Boolean
  46.     FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
  47. End Function


 
 
 Merci à tous ceux qui pourront m'aider!!

Reply

Marsh Posté le 22-05-2014 à 13:16:14   

Reply

Marsh Posté le 22-05-2014 à 15:10:27    

 
           Bonjour,
 
           en consultant l'aide VBA de la fonction  Dir  et ses exemples …
 
           Du genre initialiser par  Dir("C:\Dossier\*.xls" )  …
 

Reply

Sujets relatifs:

Leave a Replay

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