Problème programme collage de données vba

[Nimbus]

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 :

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

 

[Caillou]

Re : Problème programme collage de données vba

Bonjour,

C'est bizarre car la variable LaDate est déclarée en String.... mais admettons....
Tu peux modifier la ligne de code qui fait le NB.SI comme suit :

x = Application.WorksheetFunction.CountIf(WbSource.Worksheets("Synthese").Range("A6:A10000"), CLng(CDate(LaDate)))

Caillou

 

[Nimbus]

Re : Problème programme collage de données vba

Super merci!
La variable LaDate est en String car, je veux que le format soit fixe à jj/mm/dddd.

T'aurai mis quoi toi comme variable?

 

[Caillou]

Re : Problème programme collage de données vba

re,

j'aurais mis Date tout bêtement, mais je n'ai pas regardé tout le code...

Caillou