Problème avec le copier coller de mon VBA

Résolu/Fermé
bithack Messages postés 129 Date d'inscription mercredi 29 octobre 2014 Statut Membre Dernière intervention 16 mars 2016 - 29 oct. 2014 à 10:11
bithack Messages postés 129 Date d'inscription mercredi 29 octobre 2014 Statut Membre Dernière intervention 16 mars 2016 - 30 oct. 2014 à 13:21
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 :)
A voir également:

4 réponses

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
30 oct. 2014 à 12:26
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
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
29 oct. 2014 à 17:24
Bonjour Bithack, bonjour le forum,

Et si tu nous donnais le code... On pourrait t'aider plus facilement tu ne penses pas...
0
bithack Messages postés 129 Date d'inscription mercredi 29 octobre 2014 Statut Membre Dernière intervention 16 mars 2016 6
Modifié par bithack le 30/10/2014 à 09:00
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
bithack Messages postés 129 Date d'inscription mercredi 29 octobre 2014 Statut Membre Dernière intervention 16 mars 2016 6
30 oct. 2014 à 13:21
Oh, merci beaucoup de vôtre aide bien précieuse !!!
Merci pour les conseils et le code.
A très bientôt !
Bithack
0