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 :

Problème pour copier seulement les cellule visible


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Candidat au Club
    Homme Profil pro
    Responsable de Production
    Inscrit en
    Avril 2019
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : Responsable de Production
    Secteur : High Tech - Multimédia et Internet

    Informations forums :
    Inscription : Avril 2019
    Messages : 3
    Par défaut Problème pour copier seulement les cellule visible
    Bonjour,

    Je vous explique mon souci.

    J'ai un tableau dans lequel j'applique un filtre, suite a cela j'ai besoin de récupérer seulement les cellule visible après filtre et de les copier dans une autre feuille.

    donc logiquement : SpecialCells(xlCellTypeVisible).copy

    sauf que cette fonction me copie bien les cellule visible, mais elle me copie également tout ce qui n'est pas visible dans ma nouvelle feuille.

    Ce qui est étrange, c'est que les cellule non visible qui sont quand même copié, n'apparaissent pas dans ma nouvelle feuille, je ne m'en rend compte seulement quand je sauvegarde mon fichier.
    Quand je sauvegarde, mon fichier passe de 57Ko a 50.000Ko.

    Si ce n'est pas clair, n’hésitez pas a me le dire. Voici une copie de mon code.

    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
     
    Sub ReadDataFromCloseFile()
        On Error GoTo ErrHandler
        Application.ScreenUpdating = False
     
        Dim dir As String
        Dim file As String
     
        dir = "C:\mon_chemin"
     
        ChDrive "C"
        ChDir dir
        file = Application.GetOpenFilename()
     
        'if file different of "Faux" (False As String)
        If file <> "Faux" Then
     
            Dim src As Workbook
            Dim DEST As Workbook
            Set DEST = ThisWorkbook
     
            ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
            Set src = Workbooks.Open(file, True, True)
     
            'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
            Dim iTotalRows As Integer
            iTotalRows = src.Worksheets("ADX-UAE Alertes").Range("C16:C" & Cells(Rows.Count, "C").End(xlUp).Row).Rows.Count
     
            'Applique un filtre sur la colonne 23
            src.Worksheets("ADX-UAE Alertes").Range("$W$16:$W" & iTotalRows).AutoFilter Field:=23, Criteria1:="BHL en cours – Action support FAL"
     
            'Copie la selection sur le classeur ouvert
            src.Worksheets("ADX-UAE Alertes").Range("A15:V").End(xlDown).SpecialCells(xlCellTypeVisible).Select
            Application.CutCopyMode = False
            Selection.Copy
     
     
            'Colle la selection sur le classeur actif
            ActiveSheet.Paste Destination:=DEST.Worksheets("Extract J").Range("A2")
     
     
            ' CLEAR CLIPBOARD
            Application.CutCopyMode = False
     
            ' CLOSE THE SOURCE FILE.
            src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
            Set src = Nothing
     
     
        End If
     
        MsgBox "copie appliquée !"
     
     
    ErrHandler:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
     
    End Sub

    merci pour vos "future" réponses !

  2. #2
    Expert confirmé
    Avatar de MarcelG
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2009
    Messages
    3 449
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 68
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2009
    Messages : 3 449
    Billets dans le blog
    7
    Par défaut
    Bonjour,

    Je me permets une proposition relative à un code de Jacques Boisgontier.
    Impressionnant de rapidité.

    A adapter bien entendu.

    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
    Option Explicit
     
    Sub Filtre_Col()
       Dim dernl As Long
       Dim tbl1 As Variant, Tbl As Variant
       With Worksheets("bd")
       dernl = .Cells(.Rows.Count, 1).End(xlUp).Row
       tbl1 = .Range("A2:D" & dernl).Value
       Tbl = Filtre_Array(tbl1, "01/01/1987", 3, Array(1, 2, 4))
       If Not IsEmpty(Tbl) Then Worksheets("dest").Range("A1").Resize(UBound(Tbl), UBound(Tbl, 2) - LBound(Tbl, 2) + 1) = Tbl
     End With
     End Sub
     
     Function Filtre_Array(Tbl As Variant, clé As String, colClé As Integer, colRécup As Variant)
       Dim i As Long, n As Long, k As Long
       n = 0
       For i = 1 To UBound(Tbl)
         'Modifier le signe >, = ...
         'Modifier la fonction CDate, CStr.....
         If Tbl(i, colClé) > CDate(clé) Then n = n + 1
       Next i
       Dim Tbl2()
       ReDim Tbl2(1 To n, LBound(colRécup) To UBound(colRécup))
       n = 0
       For i = 1 To UBound(Tbl)
         'Modifier le signe >, = ...
         ''Modifier la fonction CDate, CStr.....
         If Tbl(i, colClé) > CDate(clé) Then
             n = n + 1
             For k = LBound(colRécup) To UBound(colRécup)
                    Tbl2(n, k) = Tbl(i, colRécup(k))
             Next k
         End If
       Next i
       If n > 0 Then Filtre_Array = Tbl2
     End Function

  3. #3
    Candidat au Club
    Homme Profil pro
    Responsable de Production
    Inscrit en
    Avril 2019
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : Responsable de Production
    Secteur : High Tech - Multimédia et Internet

    Informations forums :
    Inscription : Avril 2019
    Messages : 3
    Par défaut
    Tout d'abord, merci MarcelG

    Dis donc, c'est pas une petite adaptation que tu me demandes la !!!

    Il faut que j’étudie un peu le code et que je l'adapte a mon besoin. Peut être que cela correspondra a mes attentes.

    Si vous avez une autre idée, je suis également preneur.

  4. #4
    Expert confirmé
    Avatar de MarcelG
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2009
    Messages
    3 449
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 68
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2009
    Messages : 3 449
    Billets dans le blog
    7
    Par défaut
    Pas de problème djo.

    Avec un minimum de recherche, tu trouveras une aide te permettant de copier des cellules filtrées (Filtre élaboré...)

    Ce code s'adapte parfaitement à ta problématique.
    Au demeurant, mon intention était juste une information à ton endroit, certes, mais aussi à celui des autres membres du Forum.

    Nota.

    Jacques donne aussi un exemple pour trois arguments

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Sub SelectionLignesColCle()
        Tablo = [A2:D7].Value
        a = FiltreArrayLignes(Tablo, 3, "Paris")    ' On récupère les lignes de Paris en colonne 3
        [G2].Resize(UBound(a), UBound(a, 2)).Value2 = a
     End Sub
    Ici,
    3 correspond à la colonne à filtrer.
    "Paris" est le critère.

  5. #5
    Expert confirmé
    Avatar de MarcelG
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juillet 2009
    Messages
    3 449
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 68
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2009
    Messages : 3 449
    Billets dans le blog
    7
    Par défaut
    Salut à nouveau,

    Pour en venir à ton code.

    L'utilisation des cellules spéciales visibles peut être une solution.

    Cependant:
    - Supprime ces f... Select!!!
    - Cette ligne m'interroge
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    src.Worksheets("ADX-UAE Alertes").Range("A15:V").End(xlDown).SpecialCells(xlCellTypeVisible).Select
    - La copie et sa destination peuvent se coder en 1 ligne

  6. #6
    Candidat au Club
    Homme Profil pro
    Responsable de Production
    Inscrit en
    Avril 2019
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : Responsable de Production
    Secteur : High Tech - Multimédia et Internet

    Informations forums :
    Inscription : Avril 2019
    Messages : 3
    Par défaut
    Je n'ai pas encore pris le temps de tester le code que tu m'a proposé précédemment.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    src.Worksheets("ADX-UAE Alertes").Range("A15:V").End(xlDown).SpecialCells(xlCellTypeVisible).Select
    A l'origine je fais :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     src.Worksheets("ADX-UAE Alertes").Range("A16:V" & Cells(Rows.Count, "C").End(xlDown).Row).SpecialCells(xlCellTypeVisible).Copy
    mais j'ai testé d'autres solutions pour voir si le probleme ne venait pas de la.

    Pour ce qui est de l'écrire en 1 phrase, je ne connais pas, j'utilse ce bout de code la egalement dans un autre fichier qui fonctionne pas mal :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    src.Worksheets("A").Range("A3:U" & iTotalRows + 3).Copy
            ActiveSheet.Paste Destination:=dest.Worksheets("Alloc à J").Range("A2")
    mais en 2 phrases

    Merci en tous cas, je test ce week-end si tout va bien.

Discussions similaires

  1. Réponses: 5
    Dernier message: 24/11/2017, 14h16
  2. [XL-2010] Marcro: Copier seulement les cellules visibles dans un nouveau classeur Excel
    Par Samexcel dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 11/02/2015, 16h35
  3. Copier seulement les valeurs d'une cellule
    Par guilla2874 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 22/02/2008, 17h05
  4. Problème pour lister tous les lecteurs
    Par zit_zit dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 10/09/2007, 11h35
  5. [TDbGrid] connaitre les cellules visibles
    Par jbat dans le forum Delphi
    Réponses: 7
    Dernier message: 24/07/2006, 16h07

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