Bonjour,
J'ai un programme VBA qui est capable de chercher des infos dans d'autres doc excel (en PJ le doc "MC_Shootage) et les coller dans un doc commun intitulé "MC_Commun". Et cela se fait soit par date, soit pas n° semaine.
Pour le N° Semaine tout fonctionne mais, pour la date (module 2 du programme) le programme ne aucunes données.
Voici le programme :
Quelqu'un aurait une idée?
Merci pour votre aide
Nimbus
J'ai un programme VBA qui est capable de chercher des infos dans d'autres doc excel (en PJ le doc "MC_Shootage) et les coller dans un doc commun intitulé "MC_Commun". Et cela se fait soit par date, soit pas n° semaine.
Pour le N° Semaine tout fonctionne mais, pour la date (module 2 du programme) le programme ne aucunes données.
Voici le programme :
Code:
Option Explicit
Sub Macro1()
'Identification des chemins et des fichiers
Dim Chemin As String, WbDestination As Workbook, WbSource As Workbook
Dim Fichier(1 To 1) As String
Dim i As Integer
Dim cel As Range
Dim LaDate As String, 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 = ThisWorkbook.Path 'si les 2 fichiers dans même dossier
'demande à l'utilisateur la date du jour, date en cours par défaut
LaDate = Format(Now, "dd\/MM\/yyyy")
Do
LaDate = InputBox("Entrez une date", "Date", LaDate)
Loop Until IsDate(LaDate)
If LaDate = "" Then Exit Sub
Fichier(1) = "MC_Shootage.xlsm"
'Fichier(2) = "MC_Finition.xlsm"
'Fichier(3) = "MC_Expédition.xlsm"
'Fichier(4) = "MC_TS.xlsm"
'Fichier(5) = "MC_Luxe.xlsm"
'Fichier(6) = "MC_Contrôle_Composants_CARTIER.xlsm"
'Fichier(7) = "MC_Plastique.xlsm"
'Fichier(8) = "MC_Metal.xlsm"
'Fichier(9) = "MC_Witech.xlsm"
For i = 1 To 1
If FichierExiste(Chemin & "\" & Fichier(i)) Then
'ouverture du fichier en lecture seule
Workbooks.Open Filename:=Chemin & "\" & Fichier(i), UpdateLinks:=0, ReadOnly:=True
Set WbSource = ActiveWorkbook
On Error Resume Next
x = Application.WorksheetFunction.CountIf(WbSource.Worksheets("Synthese").Range("A6:A10000"), "=" & LaDate)
If x > 0 Then
With WbSource.Worksheets("Synthese")
'Transfert des données
'exemple pour ajout de ligne(s)
For Each cel In .Range("A6:A10000")
If cel = LaDate Then
With WbDestination.Worksheets("Donnees")
L = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
Application.ScreenUpdating = False
.Range("A" & cel.Row & ":N" & cel.Row).Copy
WbDestination.Worksheets("Donnees").Range("A" & L).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
Next cel
End With
End If
Application.ScreenUpdating = True
WbSource.Close SaveChanges:=False
End If
Next i
End Sub
Function FichierExiste(NomFichier As String) As Boolean
FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
End Function
Quelqu'un aurait une idée?
Merci pour votre aide
Nimbus