Copier/coller plusieurs fois ne fonctionne plus
Fermé
iadi0615
-
15 juil. 2019 à 15:55
iadi06 Messages postés 21 Date d'inscription mercredi 20 février 2019 Statut Membre Dernière intervention 27 août 2022 - 15 juil. 2019 à 23:28
iadi06 Messages postés 21 Date d'inscription mercredi 20 février 2019 Statut Membre Dernière intervention 27 août 2022 - 15 juil. 2019 à 23:28
A voir également:
- Copier/coller plusieurs fois ne fonctionne plus
- Dessin a copier coller ✓ - Forum Internet / Réseaux sociaux
- Coeur copier coller ✓ - Forum Internet / Réseaux sociaux
- Copier video youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Zizi copier coller ✓ - Forum Internet / Réseaux sociaux
2 réponses
yg_be
Messages postés
21303
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 mars 2023
1 326
15 juil. 2019 à 17:20
15 juil. 2019 à 17:20
bonjour, je pense déterminant de montrer le code de tes macros.
Kalissi
Messages postés
218
Date d'inscription
jeudi 2 mai 2013
Statut
Membre
Dernière intervention
15 juillet 2019
20
15 juil. 2019 à 22:49
15 juil. 2019 à 22:49
Bonjour,
Il me semble bien qu'il te faut fermer le copier/coller entre chaque itération ...
K
Il me semble bien qu'il te faut fermer le copier/coller entre chaque itération ...
rngSeqHor.Offset(2, 0).Resize(rngSeqHor.Rows.Count - 2, rngSeqHor.Columns.Count).Copy
wshPCDF.Cells(intLigne, intColumn + 1).PasteSpecial
Application.CutCopyMode = False ' Cette ligne doit être présente dans le cycle
K
iadi06
Messages postés
21
Date d'inscription
mercredi 20 février 2019
Statut
Membre
Dernière intervention
27 août 2022
15 juil. 2019 à 23:28
15 juil. 2019 à 23:28
Je te renvoie à ma dernière réponse à yg_be.
Il me semble que c'est le worksheet change et non le copy qui empêche le copier/coller x fois.
Il me semble que c'est le worksheet change et non le copy qui empêche le copier/coller x fois.
Modifié le 15 juil. 2019 à 22:04
Private Sub worksheet_change(ByVal target As Range) Dim wshHor As Worksheet Dim wshPCDF As Worksheet Dim wshVert As Worksheet Dim rngFindSeq As Range Dim strSeq As String Dim intNbSeq As Integer Dim rngCellSeq As Range Dim rngSeqHor As Range Dim intLigne As Integer Dim intColumn As Integer Dim I As Integer 'Permet d'optimiser la vitesse du code '________________________________________________________ Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False On Error GoTo Erreurs 'Déclaration des feuilles '_________________________________ Set wshVert = Worksheets("SeqVert") Set wshHor = Worksheets("SeqHor") Set wshPCDF = Worksheets("PCDF Séq.") 'Déclaration des variables '_________________________________ intNbSeq = wshVert.Range("bytNbSeq").Value If target.Value <> "" Then For I = 0 To intNbSeq - 1 If target.Value = wshVert.Cells(5 + I, 3).Value Then intLigne = target.Row intColumn = target.Column 'Définition des noms de séquence + recherche de la séquence dans SeqHor strSeq = target.Value 'Déclaration Range de recherche Set rngFindSeq = wshHor.Range("A1", "A65356") 'Recherche de la séquence Set rngCellSeq = rngFindSeq.Find(what:=strSeq, LookAt:=xlWhole, MatchCase:=False) Set rngSeqHor = rngCellSeq.CurrentRegion rngSeqHor.Offset(2, 0).Resize(rngSeqHor.Rows.Count - 2, rngSeqHor.Columns.Count).Copy wshPCDF.Cells(intLigne, intColumn + 1).PasteSpecial End If Next I End If 'Réinitialise Excel '________________________________________________________ Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Exit Sub '******************************************************** 'ERROR HANDLING '******************************************************** Erreurs: If Err <> 0 Then Application.EnableEvents = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True End if End Sub15 juil. 2019 à 21:38
Modifié le 15 juil. 2019 à 21:54
Modifié le 15 juil. 2019 à 22:12
Voici le code en question :
Option Explicit Option Compare Text Private Sub worksheet_change(ByVal target As Range) Dim wshVert As Worksheet Dim intLigne As Integer Dim intColumn As Integer 'Dim wsh As Worksheet 'Permet d'optimiser la vitesse du code '________________________________________________________ Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Set wshVert = Worksheets("SeqVert") 'Code '-------------------------------------------------------------- On Error GoTo Erreurs Select Case target.Value Case "SS" intLigne = target.Row intColumn = target.Column Cells(intLigne, intColumn + 1).Interior.Color = RGB(0, 255, 0) Case "SER" intLigne = target.Row intColumn = target.Column Cells(intLigne, intColumn + 1).Interior.Color = RGB(217, 225, 242) Case "PEIN" intLigne = target.Row intColumn = target.Column Cells(intLigne, intColumn + 1).Interior.Color = RGB(192, 0, 0) End Select 'Réinitialise Excel '________________________________________________________ Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Exit Sub '******************************************************** 'ERROR HANDLING '******************************************************** Erreurs: If Err <> 0 Then Application.EnableEvents = True End Sub