Problème programme collage de données vba

  • Initiateur de la discussion Initiateur de la discussion Nimbus
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Nimbus

XLDnaute Occasionnel
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 :
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
 

Pièces jointes

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 :
Code:
x = Application.WorksheetFunction.CountIf(WbSource.Worksheets("Synthese").Range("A6:A10000"), CLng(CDate(LaDate)))

Caillou
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
166
Réponses
4
Affichages
372
Réponses
2
Affichages
429
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
94
Réponses
3
Affichages
546
Retour