Discussion :

[Rob's]

Bonjour,

J'ai un programme VBA qui doir être 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 me colle aucune données.
Voici le programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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

Rob's