VBA autofilter et copie impossible

Résolu
Clark...kent Messages postés 50 Statut Membre -  
 clark...kent -
Bonjour à tous,

J'ai un premier fichier "Chargement" qui va chercher les sources de données.
Il extrait les données en fonction de la date sélectionné dans un calendar faisant référence aux titres des fichiers sources

Afin d'éviter les doublons, j'ai plusieurs boutons qui contrôle si les données
ne sont pas déjà présentes dans le fichier Chargement en fonction de cette date.
Le code correspondant est utilisé dans deux macros différentes. (1er et 2eme bouton charger du formulaire)

Premier soucis : Il fonctionne dans la première macro mais pas dans la seconde.

Deuxième soucis : Dans cette même seconde macro, j'ai un autre problème (est ce que c'est lié je ne pense pas) concernant la copie d'une zone de donnée trié selon deux critères avec autofilter.
Les deux critères sont appliqués sur des champs différents. Parfois, l'un d'eux fonctionne, parfois aucun.

Voici mon fichier "Chargement"
https://www.cjoint.com/?3Eej5BaN3gw

Voici deux exemples de fichier source
https://www.cjoint.com/?3Eej6nuevXT
https://www.cjoint.com/?BEej6C7IGXC

Pour ce qui ne pourrait pas ouvrir les fichiers, voici mes codes :

Sub Charger_Click()
Dim Ligne As Long
Dim valeur As Date
Dim resultat As Boolean
Dim Lig As String

With Sheets("Donnees")
'Positionnement sur la première ligne vide de la feuille "donnees"
Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1

Application.ScreenUpdating = False
Worksheets("Chargement").Select
valeur = Range("A3").Value
Worksheets("Donnees").Select
Columns("A:A").Select
On Error GoTo gestionnaireerreur
resultat = Selection.Find(valeur).Select
Worksheets("Chargement").Select
If resultat = True Then
MsgBox ("Les données sont déjà chargées")
GoTo copie
End If

gestionnaireerreur:
Worksheets("Chargement").Select
If resultat = False Then
MsgBox ("Les données sont en cours de chargement")
End If

With Sheets("Chargement")
If Dir("C:\" & Format([A3].Value, "dd mm yyyy") & ".xls") = "" Then
MsgBox "le fichier est introuvable!"
For Each Ctrl In Acceuil.Controls
If TypeOf Ctrl Is MSForms.ComboBox Then Equipe = ""
Next Ctrl
For Each Ctrl In Acceuil.Controls
If TypeOf Ctrl Is MSForms.ComboBox Then Agent = ""
Next Ctrl
For Each Ctrl In Acceuil.Controls
If TypeOf Ctrl Is MSForms.OptionButton Then Ctrl.Object.Value = False
Next Ctrl
Exit Sub
End If

Sheets("Chargement").Select
With Workbooks.Open("C:\" & Format([A3].Value, "dd mm yyyy") & ".xls")
' Copier les données de la feuille "Temps Conseillers" dans la première ligne vide de la feuille "Données"
.Sheets("Temps Conseillers").Range("A2:K39").Copy Destination:=Workbooks("Test.xlsm").Worksheets("Donnees").Range("C" & Ligne)
.Close savechanges:=False

With Sheets("Donnees")
With .Range("B" & Ligne & ":B" & .Range("C" & Rows.Count).End(xlUp).Row)
.Formula = "=IF(RC[6]="""","""",IF(RC[6]=100%,""Oui"",""Non""))"
.Value = .Value ' Aucune formule
End With
.Range("A" & Ligne & ":A" & .Range("C" & Rows.Count).End(xlUp).Row) = Format(Sheets("Chargement").Range("A3"), "mm/dd/yyyy")

copie:
Lig = .Range("M65536").End(xlUp).Row
Sheets("Resultats").Rows("2:" & Lig).Delete

Worksheets("Donnees").Select
.Range("A1:M" & Lig).AutoFilter Field:=1, Criteria1:=.[N1]
.Range("A1:M" & Lig).AutoFilter Field:=2, Criteria1:=.[O1]
On Error Resume Next 'si pas de résultat
.Range("A2:M" & Lig).SpecialCells(xlCellTypeVisible).Copy Sheets("Resultats").[A2]
.Range("A1:M" & Lig).AutoFilter
Sheets("Donnees").Select
ActiveSheet.AutoFilterMode = False
'Sheets("Resultats").Select
'ActiveSheet.AutoFilterMode = False

Application.ScreenUpdating = True

ActiveWorkbook.Save
MsgBox "Vos données ont été chargé et sauvegardé"

Unload Me

End With
End With
End With
End With
End Sub

Un grand merci à tous!

Signé : Un utilisateur VBA Excel 2007 Pro de 3 semaines :)

13 réponses

  1. clark...kent
     
    Alors j'ai essayé plusieurs, j'ai retourné ton petit bout de code dans tous les sens mais ca ne marche pas.

    Et pire quand je réinscrit mon code d'origine il ne fonctionne plus, heureusement j'avais une sauvegarde.

    J'ai tenté de changé les formats de cellule en date, en nombre tout et tes trois petites lettres ne fonctionnent pas

    merci quand meme
    1
  2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    EXCEL2007 pose pas mal de soucis sur les filtres date en Criteria2. Je vais chercher une solution. Vous n'etes pas le premier dans ce cas.

    A bientot
    1
  3. Clark...kent Messages postés 50 Statut Membre 2
     
    Une partie de la solution, impossible de mettre des dates au format date dans un critère autofilter alors je les mets au format numéro en rajoutant une collone.

    Sub Charger_Click()
    Dim Ligne As Long
    Dim valeur As Date
    Dim resultat As Boolean
    Dim Lig As Long
    Dim Lige As Long

    With Sheets("Donnees")
    'Positionnement sur la première ligne vide de la feuille "donnees"
    Ligne = .Range("C" & Rows.Count).End(xlUp).Row + 1

    'Ouverture des fichiers non visible en tâche de fond
    Application.ScreenUpdating = False

    'Chargement du fichier selon la date séléctionnée dans le Calendrier

    Application.ScreenUpdating = False
    Worksheets("Chargement").Select
    valeur = Range("A3").Value
    Worksheets("Donnees").Select
    Columns("A:A").Select
    On Error GoTo gestionnaireerreur
    resultat = Selection.Find(valeur).Select
    Worksheets("Chargement").Select
    If resultat = True Then
    MsgBox ("Les données sont déjà présentes")
    GoTo copie
    End If

    gestionnaireerreur:
    Worksheets("Chargement").Select
    If resultat = False Then
    MsgBox ("Les données vont être chargées")
    End If

    With Sheets("Chargement")
    If Dir("C:\" & Format([A3].Value, "dd mm yyyy") & ".xls") = "" Then
    MsgBox "le fichier est introuvable!"

    For Each Ctrl In Acceuil.Controls
    If TypeOf Ctrl Is MSForms.ComboBox Then Equipe = ""
    Next Ctrl
    For Each Ctrl In Acceuil.Controls
    If TypeOf Ctrl Is MSForms.ComboBox Then Agent = ""
    Next Ctrl
    For Each Ctrl In Acceuil.Controls
    If TypeOf Ctrl Is MSForms.OptionButton Then Ctrl.Object.Value = False
    Next Ctrl
    Exit Sub
    End If

    Application.ScreenUpdating = False
    Sheets("Chargement").Select
    With Workbooks.Open("C:\" & Format([A3].Value, "dd mm yyyy") & ".xls")
    ' Copier les données de la feuille "Temps Conseillers" dans la première ligne vide de la feuille "Données"
    .Sheets("Temps Conseillers").Range("A2:K39").Copy Destination:=Workbooks("Test.xlsm").Worksheets("Donnees").Range("C" & Ligne)
    .Close savechanges:=False

    With Sheets("Donnees")
    With .Range("B" & Ligne & ":B" & .Range("C" & Rows.Count).End(xlUp).Row)
    .Formula = "=IF(RC[6]="""","""",IF(RC[6]=100%,""Oui"",""Non""))"
    .Value = .Value ' Aucune formule
    End With
    .Range("A" & Ligne & ":A" & .Range("C" & Rows.Count).End(xlUp).Row) = Format(Sheets("Chargement").Range("A3"), "mm/dd/yyyy")

    With Sheets("Resultats")
    With .Range("B" & Ligne & ":B" & .Range("C" & Rows.Count).End(xlUp).Row)
    .Formula = "=IF(RC[6]="""","""",IF(RC[6]=100%,""Oui"",""Non""))"
    .Value = .Value ' Aucune formule
    End With
    '.Range("A" & Ligne & ":A" & .Range("C" & Rows.Count).End(xlUp).Row) = Format(Sheets("Chargement").Range("A3"), "mm/dd/yyyy")

    copie:
    With Sheets("Donnees")
    Lige = .Range("N65536").End(xlUp).Row
    Sheets("Resultats").Rows("2:" & Lige).Delete
    With Sheets("Donnees")
    Lig = .Range("M65536").End(xlUp).Row
    .Range("A1:N" & Lig).AutoFilter Field:=14, Criteria1:=.[O1]
    .Range("A1:M" & Lig).AutoFilter Field:=2, Criteria1:=.[Chargement!A6]
    On Error Resume Next 'si pas de résultat
    .Range("A2:N" & Lig).SpecialCells(xlCellTypeVisible).Copy Sheets("Resultats").[A2]
    .Range("A1:N" & Lig).AutoFilter
    Sheets("Resultats").Select

    Application.ScreenUpdating = True

    ActiveWorkbook.Save
    MsgBox "Vos données ont été chargé et sauvegardé"

    Unload Me
    End With
    End With
    End With
    End With
    End With
    End With
    End With
    End Sub
    0
  4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,
    Il n'est pas necessaire de rajouter une colonne date en nombre.
    Il suffit de convertir ex: CDbl(.[A3]) pour la date de A3

    Criteria1:=.[N1] donne Criteria1:=CDbl(.[N1] )

    Pour je vais voir.
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. clark...kent
     
    ok je vais essayer ca je mets résolu si ca fonctionne

    MERCI!
    0
  7. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    Regarde ce fichier (le votre un peu modifie ou CDbl(.[N1] ) marche)

    https://www.cjoint.com/?BEhrYWM6c2l

    Bon courage
    0
  8. clark...kent
     
    Bonjour,
    Désolé pour l'attente :s

    Merci car tu as vraiment bien amélioré mon code, il m'aurait fallu une semaine pour faire ça!

    J'ai essayé ton fichier et il ne fonctionne pas, quand je sélectionne le 4 Mai pour exemple et charge les champs hors normes, je n'ai aucun résultat :|

    Merci de ton aide
    0
  9. clark...kent
     
    Ok effectivement c'est pas la première fois qu'on me dit que 2007 pose des problèmes, sous quel version travaillez vous?

    Avant que vous n'avanciez plus loin (si ca peut vous aider), je suis en train de mettre en place un compteur semaine.

    Le but de ce critère est de faire un tri journalier, hebdomadaire, ou mensuel de ma feuille données.

    Exemple si il sélectionne le 1er Janvier, alors je vais devoir faire un tri de l'activité de la semaine 1.
    0
  10. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    ACCESS2003 et/ou 2007 voir 2010
    0
  11. clark...kent
     
    j'ai peut être une idée.

    Dans les données que j'importe dans la feuille donnees justement.

    Et si grâce à une macro, je change le format de date en Nombre du genre 41300.
    Si il s'affiche de cette facon dans la feuille donnees, peu importe.

    Par contre, une fois les données insérés, je filtre, je copie toujours avec ma macro et je colle mais cette fois en changeant de nouveau le format de date en "dd mm yyyy" dans la feuille resultat.

    Est ce une bonne idée? et comment je peux transiter d'un format à un autre grâce à une macro.

    Car si 2007 bug sur la date autant le forcer à changer le format du critère.

    Je creuse je creuse... :)
    0
  12. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    Oui, a essayer. Il faudra un format nombre pour la colonne.
    0
  13. clark...kent
     
    ok mais comment je peux faire pour qu'il me renvoi la valeur de la colonne A vers la ligne correspondante ou il a pris la valeur.

    J'ai bien essayé de mettre la valeur dans une variable et de descendre un à un avec active offset mais ca ne fonctionne pas.
    0
  14. clark...kent
     
    Un peu de bidouille mais ca fonctionne.

    'Insertion de la date au format nombre pour le tri
    Sheets("Donnees").Select
    Columns("N:N").Value = Columns("A:A").Value
    Columns("N:N").NumberFormat = "General"

    J'inscris ma date en colonne A et je l'inscris au format nombre en collone N.

    Mon critère lui aussi doit être au format Nombre pour être
    puisé dans la colonne N. Et là ça fonctionne.

    Rien trouvé de mieux, Système D mais ça fonctionne.

    Merci f894009
    0