Simplifier un code

loulou14 · 1 Avril 2012

Bonsoir

J'ai un code qui fonctionne pour copier et coller des valeurs d'une feuille programme à une une feuille 1.
Je souhaiterais simplifier le code pour éviter les passages répétitifs d'un écran à un autre (douloureux pour les yeux !!!
Voici un extrait du code sachant que le copier/coller se répéte pour plusieurs cellules

Sub Essai
Dim Derlign As Long, c As Variant
Dim VIS As String

3 Do
Sheets("programme").Select ' selectionne la feille contenant les items
Range("AQ3:AQ65000").Select ' selectionne la colonne contenant les données
VIS = InputBox("Saisir le N° de VIS :") ' boite de dialogue pour entrer une donnée
If VIS = "" Then GoTo 21
Set c = Sheets("programme").Columns(43).Cells.Find(What:=VIS, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not c Is Nothing Then
Else
MsgBox "VIS non trouvée": GoTo 3
End If

Sheets("programme").Select
c.Offset(0, 76).Select
Selection.Copy
Sheets("Feuil1").Select
DerlignD = Range("D24").End(xlUp).Row + 2
Range("D" & DerlignD).Activate
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub

Merci d'avance de vos conseils avisés

JANO · 1 Avril 2012

Re : Simplifier un code

Bonjour Loulou14,

je ne sais pas pour simplifier la macro.
Par contre si tu mets
Application.ScreenUpdating = False
au début de ta macro, cela devrait régler ton problème.
Cdt

loulou14 · 1 Avril 2012

Re : Simplifier un code

Merci JANO. Ce "Application.ScreenUpdating = False" va m'éviter des migraines.

Si toutefois quelq'un voit une solution pour simplifier le code, je suis preneur

Efgé · 1 Avril 2012

Re : Simplifier un code

Bonjour loulou14, JANO,
On peux commencer par ne pas selectionner du tout.
A tester

VB:

Sub Essai2()
Dim Derlign As Long, c As Range
Dim VIS As String
'3 Do
VIS = InputBox("Saisir le N° de VIS :") ' boite de dialogue pour entrer une donnée
If VIS = "" Then GoTo 21
Set c = Sheets("programme").Columns(43).Cells.Find(What:=VIS, _
                    LookIn:=xlValues, LookAt:=xlWhole, _
                    SearchOrder:=xlByColumns)
If Not c Is Nothing Then
    c.Offset(0, 76).Copy Sheets("Feuil1").Range("D24").End(xlUp).Offset(2, 0)
Else
    MsgBox "VIS non trouvée": GoTo 3
End If
End Sub

Cordialement

Simplifier un code

loulou14

XLDnaute Nouveau

JANO

XLDnaute Occasionnel

loulou14

XLDnaute Nouveau

Efgé

XLDnaute Barbatruc

Discussions similaires