paul25 | 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 :
- Sub Dechet_Finition_Hebdo()
- 'Identification des chemins et des fichiers
- Dim Chemin As String, WbDestination As Workbook, WbSource As Workbook
- Dim Fichier As String
- Dim Semaine As Long, L As Long, x As Long
- Set WbDestination = ThisWorkbook
- L = WbDestination.Worksheets("Donnees" ).Range("A65536" ).End(xlUp).Row + 1
- WbDestination.Worksheets("Donnees" ).Range("A6:N" & L).ClearContents
-
- 'Chemin = "X:\30_QUALITE\307_Gestion_de_service\Lyse\AAAA-Main-Courante-Atelier\Recherches pour MC_commun\MC_commun"
- Chemin = ThisWorkbook.Path 'si les 2 fichiers dans même dossier
-
- 'demande à l'utilisateur le numéro de semaine, semaine en cours par défaut
- Semaine = InputBox("N° de la semaine", "SEMAINE", DatePart("ww", Date, vbMonday) - 1)
- If Semaine = 0 Then Exit Sub
- Fichier = "MC_Shootage.xlsm"
- If FichierExiste(Chemin & "\" & Fichier) Then
- 'ouverture du fichier en lecture seule
- Workbooks.Open Filename:=Chemin & "\" & Fichier, UpdateLinks:=0, ReadOnly:=True
- Set WbSource = ActiveWorkbook
- On Error Resume Next
- x = Application.WorksheetFunction.CountIf(WbSource.Worksheets("Synthese" ).Range("B5:B1000" ), "=" & Semaine)
- If x > 0 Then
- With WbSource.Worksheets("Synthese" )
- 'Transfert des données
- 'exemple pour ajout de ligne(s)
- For Each cel In .Range("B6:B1000" )
- If cel = Semaine Then
- L = WbDestination.Worksheets("Donnees" ).Range("A65536" ).End(xlUp).Row + 1
- .Range("A" & cel.Row & ":N" & cel.Row).Copy Destination:=WbDestination.Worksheets("Donnees" ).Range("A" & L)
- End If
- Next cel
- End With
- WbSource.Close SaveChanges:=False
- Else
- WbSource.Close SaveChanges:=False
- End If
- End If
- End Sub
- Function FichierExiste(NomFichier As String) As Boolean
- FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
- End Function
|
Merci à tous ceux qui pourront m'aider!! |
