Problème avec le copier coller de mon VBA

Résolu
bithack Messages postés 143 Statut Membre -  
bithack Messages postés 143 Statut Membre -
Bonjour, voici mon problème, Je suis actuellement sur du développement VBA. J'ai un soucis au niveau du copier coller. j'ai plusieurs feuille sous excel. Ma macros est censé copier une première fois avec le critère "*client" et la deuxième fois avec le critère "pas*", mes filtres fonctionnent très bien or le problème, mon premier filtre se copie bien sur une autre feuille suspendu, par contre quand mon deuxième filtre se copie bien sur suspendu mais supprime ma copie d'avant (filtre "*client") .
J'espère avoir été assez précis et compréhensif!
merci par avance et bonne journée :)

4 réponses

  1.
    ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonjour Bithack, bonjour le forum,

    Le problème avec l'enregistreur de macro, qui est par ailleurs un excellent moyen d'apprendre, c'est qu'il enregistre tout et donc beaucoup de choses inutiles...
    Ci-dessous ton code épuré et commenté. Je n'ai pas pu tester sans fichier exemple mais le pense qu'il devrait marcher. 

    Sub test()
    Dim E As Object 'déclare la variable E (onglet Export)
    Dim R As Object 'déclare la variable R (onglet Résiliés sans du)
    Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

    Set E = Sheets("export") 'définit l'onglet E
    Set R = Sheets("résiliés sans du") 'définit l'onglet R
    Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

    'filtre en A1 la colonne 29 (=AC) de l'onglet E avec "Pas d'acces réseau" comme critère (remarque :pourquoi un accent a "réseau" et pas à "accès" ?)
    E.Range("A1").AutoFilter Field:=29, Criteria1:="Pas d'acces réseau"
    E.Cells.SpecialCells(xlCellTypeVisible).Copy R.Range("A1") 'copie les cellules visiles (non filtrées) dans la cellule A1 de l'onglet R
    E.Range("A1").AutoFilter 'supprime le filtre automatique en A1 de l'onglet E

    'filtre en A1 la colonne 24 (=X) de l'onglet R avec "*DB" et "<>0" comme critères
    R.Range("A1").AutoFilter Field:=24, Criteria1:="*DB", Operator:=xlAnd, Criteria2:="<>0"
    R.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'supprime les lignes visibles
    R.Range("A1").AutoFilter 'supprime le filtre automatique en A1 de l'onglet R

    'filtre en A1 la colonne 29 (=AC) de l'onglet E avec "*client" comme critère
    E.Range("A1").AutoFilter Field:=29, Criteria1:="=*client"
    Set DEST = R.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0) 'définit la cellule de destination DEST (laisse une ligne vide entre les deux tableaux)
    R.Cells.SpecialCells(xlCellTypeVisible).Copy DEST 'copie les cellules visiles (non filtrées) dans la cellule DEST de l'onglet R
    E.Range("A1").AutoFilter 'supprime le filtre automatique en A1 de l'onglet E

    'filtre en A1 la colonne 24 (=X) de l'onglet E avec "=0" ou "*CR" comme critères
    E.Range("A1").AutoFilter Field:=24, Criteria1:="=0", Operator:=xlOr, Criteria2:="=*CR"
    Set DEST = E.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0) 'définit la cellule de destination DEST (laisse une ligne vide entre les deux tableaux)
    R.Cells.SpecialCells(xlCellTypeVisible).Copy DEST 'copie les cellules visiles (non filtrées) dans la cellule DEST de l'onglet R
    E.Range("A1").AutoFilter 'supprime le filtre automatique en A1 de l'onglet E

    Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
    End Sub


    Une remarque générale. Évite autant que tu les peux les Select qui ne font que ralentir l'exécution du code. Par exemple : 

    Sheets(Feuil1").Select
    Range("A1").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Range("B1").Select
    ActiveSheet.Paste

    peut s'ecrire tout simplement : 

    Sheets("Feuil1").Range("A1").Copy Sheets("Feuil2").Range("B1")

    1
  2. ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonjour Bithack, bonjour le forum,

    Et si tu nous donnais le code... On pourrait t'aider plus facilement tu ne penses pas...
    0
  3. bithack Messages postés 143 Statut Membre 6
     
    oui Thautheme, voici mon code, attention c'est mon premier, les erreurs doivent être surement bête mais pour un débutant elle ne le sont pas ^^
    bonne journée et merci pour vos réponses :) 
    Sub test()
Sheets("export").Select
    Application.CutCopyMode = False
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveSheet.Range("$A$1:$AC2000").AutoFilter Field:=29, Criteria1:= _
    "Pas d'acces réseau"
     Cells.Select
    Range("M1").Activate
    Selection.Copy
   Sheets("résiliés sans du").Select
   ActiveSheet.Paste ' colle dans resilliés sans du
   Sheets("résiliés sans du").Select
   ActiveSheet.Range("$A$1:$AC2000").AutoFilter Field:=24, Criteria1:= _
   "*DB", Operator:=xlAnd, Criteria2:="<>0"
   Cells.Select
   Selection.EntireRow.Delete
   Sheets("export").Select
 ActiveWindow.ScrollColumn = 14
   ActiveWindow.ScrollColumn = 13
  ActiveWindow.ScrollColumn = 12
   ActiveWindow.ScrollColumn = 11
   ActiveWindow.ScrollColumn = 9
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.ScrollColumn = 6
   ActiveWindow.ScrollColumn = 5
  ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
   ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
   ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
   ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
  ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
 ActiveWindow.ScrollColumn = 13
    ActiveSheet.Range("$A$1:$AC2000").AutoFilter Field:=29, Criteria1:= _
        "=*client"
  Cells.Select
  Range("M1").Activate
   Selection.Copy
   Range("A1000").Activate
   Sheets("résiliés sans du").Select
  Range("A1000").Activate
     ActiveSheet.Paste
      Sheets("export").Select
    Worksheets("export").AutoFilterMode = False
       ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
      ActiveSheet.Range("$A$1:$AC2000").AutoFilter Field:=24, Criteria1:= _
        "=0", Operator:=xlOr, Criteria2:="=*CR"
    Cells.Select
    Range("M1").Activate
    Selection.Copy
    Sheets("résiliés sans du").Select
    Range("A2000").Activate
    'Selection.Paste
    ActiveSheet.Paste
   

End Sub
    0
  4. bithack Messages postés 143 Statut Membre 6
     
    Oh, merci beaucoup de vôtre aide bien précieuse !!!
    Merci pour les conseils et le code.
    A très bientôt !
    Bithack
    0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses
Arobase
Zezette -
MPMP10 -

1 réponse
comment faire une arobase
GLORIA -
baladur13 -

1 réponse
Copier coller une image de Google sur Macbook
orianepark -
dede74000 -

1 réponse