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

[parmi]

Bonjour,

Comme LaDate est déclarée As String et que cel est probablement une vraie date, ça ne peut pas passer ici

Code :

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

If cel = LaDate Then

Tu pourrais essayer

Code :

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

If Cel.Text = LaDate Then

Autrement, tu pourrais faire un filtre sur la date et tout copier d'un coup en utilisant
SpecialCells(xlCellTypeVisible)

[Rob's]

Bonjour,

Merci pour ton aide.

Bonne journée

[Philippe Tulliez]

Bonjour,
Une autre solution est d'utiliser la filtre avancé d'excel, très simple à mettre en place pour faire de l'exportation suivant critères.
Tutoriel à lire sur le sujet Les filtres avancés ou élaborés dans Excel
En VBA on utilise la méthode AdvancedFilter de l'objetRange que l'on va appeler pour l'exemple rngSource.
Tu places la zone des critères que l'on nommera pour l'exemple rngCriteria dans le même classeur que ta feuille [Synthese] mais cette zone peut se trouver aussi sur une autre classeur.
Tu boucles sur l'ensemble de tes feuilles de données
Par exemple : Attention ce n'est pas du code à copier comme tel

Code :

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

1
2
3
4
For sh = 1 to NbreDeFeuilleALire
  rngSource.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=LaPlageDeLaFeuille[Synthese]
  ' Code de suppression de la ligne des étiquettes de colonnes
Next

Tu dois calculer chaque fois où se trouve la dernière ligne de LaPlageDeLaFeuille[Synthese] afin d'exporter à partir de la dernière ligne + 1. Le filtre avancé copiera la ligne avec des étiquettes de colonnes qu'il faudra supprimer à chaque incrémentation de la boucle.

[capi81]

Salut Phillipe et le forum

Merci pour votre feedback.
J'ai du mal à comprendre le code pour pouvoir l'adapter à mon cas.
Pouvez-vous passer par la méthode des filtres avancés pour trouver une solution à mon besoin?
Merci