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
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
A voir également:
- Problème avec le copier coller de mon VBA
- Copier coller pdf - Guide
- Historique copier-coller android - Guide
- Copier-coller - Accueil - Windows
- Symbole clavier copier coller - Guide
- Style d'écriture a copier coller - Guide
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
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.
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 :
peut s'ecrire tout simplement :
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")
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
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...
Et si tu nous donnais le code... On pourrait t'aider plus facilement tu ne penses pas...
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
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 :)
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
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
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
Merci pour les conseils et le code.
A très bientôt !
Bithack