IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Copier / Inserer données [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    apt
    apt est déconnecté
    Membre éclairé
    Inscrit en
    Mai 2002
    Messages
    867
    Détails du profil
    Informations forums :
    Inscription : Mai 2002
    Messages : 867
    Par défaut Copier / Inserer données
    Bonsoir à tous,

    Pour copier ensuite insérer le résultat d'un filtre automatique, j'utilise le code suivant :


    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
    Sub Test_Filter()
        Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
        Dim Clgn As Long
        Dim Rng As Range, Rng_Insp As Range
     
        Application.ScreenUpdating = False
     
        Set WS1 = Worksheets("Base")
        Set WS2 = Worksheets("Semaine")
        Set WS3 = Worksheets("Insp")
     
        Application.EnableEvents = False
        date_debut = Date - Application.Choose(Application.Weekday(Date, 1), 4, 5, 6, 0, 1, 2, 3)
        date_fin = date_debut + 6
        With WS1
            If .AutoFilterMode = False Then .Range("A7:F7").AutoFilter
            .Range("A7:F7").AutoFilter Field:=3, Criteria1:=">=" & Format(date_debut, "0") _
                                     , Operator:=xlAnd, Criteria2:="<=" & Format(date_fin, "0")
     
            Set Rng = .[_filterdatabase].Resize(, 6).SpecialCells(xlCellTypeVisible)
            Clgn = .[_filterdatabase].Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1
            MsgBox "Clgn = " & Clgn
     
        End With
     
        If Clgn > 0 Then
            Rng.Copy
            '-- Extration des données dans la feuille "Semaine"
            With WS2
                .Range(.[A10], .[G10].End(xlDown)).Delete shift:=xlUp
                .Range("A10").insert shift:=xlDown    ', CopyOrigin:=xlFormatFromLeftOrAbove
                .[E8].Value = "Semaine du " & date_debut & " au " & date_fin
            End With
     
            '-- Extration des données dans la feuille "Insp"
            With WS3
                Rng_Insp = Union(Rng.Column(1), Rng.Column(5), Rng.Column(3), Rng.Column(6))
                Rng_Insp.Copy
                .Range(.[A2], .[D2].End(xlDown)).Delete shift:=xlUp
                .Range("A2").insert shift:=xlDown
            End With
     
            On Error Resume Next
            WS1.ShowAllData
            On Error GoTo 0
        End If
     
        Set WS1 = Nothing: Set WS2 = Nothing
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Sub

    Mais voila je n'ai rien d'insérer dans la deuxième et troisième feuille (WS2, WS3) !

    Une correction possible ?

    Merci d'avance.

  2. #2
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Bonjour,

    Il y a plusieurs problèmes. Quand tu éxécute :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    .Range(.[A10], .[G10].End(xlDown)).Delete shift:=xlUp
    la copie s'efface. Ensuite, la plage copiée ne s'insère pas si les zones la composant ne sont pas continues. Je te propose :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
            With WS2
                .Range(.[A10], .[G10].End(xlDown)).Delete shift:=xlUp
                .Range("A10").Resize(8, 6).Insert shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                Rng.Copy .Range("A10")
                .[E8].Value = "Semaine du " & date_debut & " au " & date_fin
            End With
    Je n'ai pas regardé plus loin sauf que tu as une erreur de compilation ici :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Rng_Insp = Union(Rng.Column(1), Rng.Column(5), Rng.Column(3), Rng.Column(6))
    où il faut mettre des "s à "Column".

  3. #3
    apt
    apt est déconnecté
    Membre éclairé
    Inscrit en
    Mai 2002
    Messages
    867
    Détails du profil
    Informations forums :
    Inscription : Mai 2002
    Messages : 867
    Par défaut
    Bonsoir Daniel,

    Maintenant il y a bien insertion de lignes copiées, mais le "Resize" des lignes pour laisser de la place aux lignes insérées m'efface du texte fixe au dessous du tableau et qui ne doit pas être supprimé !

  4. #4
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Oups,

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    .Range("A10").Resize(Clgn + 1, 6).Insert shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove

  5. #5
    apt
    apt est déconnecté
    Membre éclairé
    Inscrit en
    Mai 2002
    Messages
    867
    Détails du profil
    Informations forums :
    Inscription : Mai 2002
    Messages : 867
    Par défaut
    Salut Daniel,

    Ça continue encore à supprimer le texte en bas

    Voila l'exemple en pièce jointe.

    Bonjour,

    C'est cette ligne, qui efface le texte en bas :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    .Range(.[A10], .[G10].End(xlDown)).Delete Shift:=xlUp
    Pourtant il y a bien un espace entre le bas du tableau et le texte à conserver
    Fichiers attachés Fichiers attachés

  6. #6
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Bonjour,

    Oui, mais elle était dans le code d'origine ? Si elle te gênait, tu aurais dû t'apercevoir que non seulement le collage ne se faisait pas, mais que les données étaient effacées, non ?

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Copier les données dans base externe
    Par bozolozo dans le forum Access
    Réponses: 2
    Dernier message: 10/05/2006, 09h56
  2. [VBA-A]Copier des données d'Excel vers Word
    Par soad029 dans le forum VBA Word
    Réponses: 15
    Dernier message: 16/03/2006, 11h56
  3. Copier des données dans le presse papier
    Par Orakle dans le forum Access
    Réponses: 11
    Dernier message: 06/12/2005, 14h11
  4. [Oracle 8.1.7] Copier les données d'un tablespace
    Par bobunny dans le forum Oracle
    Réponses: 2
    Dernier message: 01/12/2005, 14h34
  5. [ADO.Net][VB.NET] Comment copier des données entre deux BDD différentes ?
    Par maddog2032 dans le forum Accès aux données
    Réponses: 6
    Dernier message: 06/06/2005, 11h01

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo