Généraliser un code

**Nonno 94** · 17/11/2013, 16h16

Bonjour le forum,

j'ai besoin de votre aide pour modifier le code ci-dessous qui me permettra d'exécuter une macro pour les quelques 200 lignes concernées sans avoir à écrire autant de fois la condition "If ....End if".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub Macro1()
'
' Macro1 Macro
'
 
'
 
If [A1] <> "" Then
            ActiveSheet.Unprotect
    Range("A1").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End If
 
If [A2] <> "" Then
            ActiveSheet.Unprotect
    Range("A2").Select
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End If
 
If [A3] <> "" Then
            ActiveSheet.Unprotect
    Range("A3").Select
    Selection.Copy
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 End If
 
   If [A4] <> "" Then
            ActiveSheet.Unprotect
    Range("A4").Select
    Selection.Copy
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 End If
 
 
 
 
 
 
    If [A240] <> "" Then
            ActiveSheet.Unprotect
    Range("A240").Select
    Selection.Copy
    Range("D240").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 End If
 
 
 
            ActiveSheet.Protect
End Sub

Je vous remercie pour vos réponses et vous souhaite une bonne fin de journée.
Cordialement.

**nibledispo** · 17/11/2013, 16h38

Bonjour,

peut-être ceci logé dans la feuille concernée ou dans un module standard:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub copie()
 
With Sheets("feuil2") ' mettre le nom de feuille concerné
derlig = Range("a65000").End(xlup).Row
 
ActiveSheet.Unprotect
 
For i = 1 to derlig 
If Range("a" & i) <> "" Then
    Range("A" & i).Copy
    Range("D" & i).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
Next i
ActiveSheet.Protect
End With
 
End Sub

Je ne vois pas l’intérêt de ce code qui revient à copier en D le contenu de la colonne A. Ce qui peut-être fait directement sans boucle.
S'il faut dans la copie ne pas reproduire les cellules vide c'est autre chose.

**Nonno 94** · 17/11/2013, 16h51

Bonjour nibledispo et merci pour votre réponse.

votre code fonctionne seulement jusqu'à la ligne 4 sans que je comprenne la raison de cet arrêt alors que la liste d'essai continue jusqu'à la ligne 16 !

AB SCIENCE			AB SCIENCE
ABC ARBITRAGE			ABC ARBITRAGE
			
AEROPORTS DE P			AEROPORTS DE P
			
AIR FRANCE -KL			
AIR LIQUIDE			
AKKA TECHNOLOG			
ALCATEL-LUCENT			
			
			
			
ALTAREA			
ALTEN			
ALTRAN TECHN.			
ANF IMMOBILIER

Pouvez-vous m'indiquer la raison de cet arrêt intempestif ?
Merci.

**nibledispo** · 17/11/2013, 16h56

regarde à nouveau mon code édité.

je dois m'absenter.

**phanoulevoyou** · 17/11/2013, 17h07

Bonsoir Nonno,

je viens de tomber sur ton problème et j'ai également essayé la solution de nibledispo.

Cette dernière fonctionne chez moi, (office 2007).

Peux tu nous mettre le code que tu as recopier de Nibledispo, juste pour voir !

Cdlt,
PLV.

**Nonno 94** · 17/11/2013, 17h12

Re,

je viens de constater que le code s'arrête parce que la liste comporte des cellules vides.
Est-ce un obstacle insurmontable ?
La macro à exécuter est une macro "exemple"; celle que je souhaite utiliser devra ouvrir des pages internet et les copier dans un fichier puis comparer les données recueillies avec d'autres précédemment enregistrées.

Dans l'attente.
Nonno 94.

**phanoulevoyou** · 17/11/2013, 17h48

Re,

qu'entends tu par liste avec des cellules vides ?

Lorsque tu renseignes la colonne A logiquement ça remplit D
Si une cellule de A est vide ça n'interrompt pas la macro... car dans le code les cellules vides ne sont pas prises en comptes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Range("a" & i) <> "" Then

et donc la macro se poursuit jusqu'à la fin du dernier mot trouvé dans la colonne A.

**Nonno 94** · 17/11/2013, 18h48

je vous joins le fichier qui, je l'espère, sera plus explicite que moi.
La macro exécutée est la macro copie.

Remerciements pour votre patience.

**nibledispo** · 17/11/2013, 19h29

re,

je t'ai demandé de tenir compte de ma réponse éditée qui marche parfaitement.

le voila de nouveau ainsi que son code simplifié (copie_2)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub copie()
 
With Sheets("feuil1") ' mettre le nom de feuille concerné
   ActiveSheet.Unprotect
   derlig = Range("a65000").End(xlUp).Row
   For i = 1 To derlig
      If .Range("a" & i) <> "" Then
         .Range("A" & i).Copy
         .Range("D" & i).PasteSpecial Paste:=xlPasteValues    'Range("D" & i)
         Application.CutCopyMode = False
      End If
   Next i
ActiveSheet.Protect
End With
 
End Sub
 
 
 
 
Sub copie_2()
 
With Sheets("feuil1") ' mettre le nom de feuille concerné
   derlig = .Range("a65000").End(xlUp).Row
   ActiveSheet.Unprotect
   .Range("d1:d" & derlig) = .Range("a1:a" & derlig)
   ActiveSheet.Protect
End With
 
End Sub

a+

**Marc-L** · 17/11/2013, 19h37

Salut Paul !

De toute manière cette discussion est encore un doublon ‼

Voir [XL-2007] Macro répétitive exécutée sous condition …

**phanoulevoyou** · 17/11/2013, 19h42

Re,

Oups... nibledispo t'a donné la solution mais tu ne l'as pas suivi alors que son code fonctionne très bien.

Tu as mis :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

derlig = Range("a2").End(xlDown).Row

et nibledispo lui a mis :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

derlig = Range("a65000").End(xlUp).Row

Voici toute la différence...

En gros j'explique les experts me corrigeront :

Ta variable i par ton code est au minimum (dans ton exemple elle n'est que de 4 lignes) les infos que tu lui donnes sont "je pars du haut et dès que je rencontre une cellule vide je m'arrête et je garde en mémoire la dernière cellule non vide" vu que la ligne 5 est vide le nombre de ta variable s'arrête à 4.

Alors qu'avec le code de nibledispo, il part du bas, "dès qu'il trouve la première cellule qui n'est pas vide il s'arrête et prend le numéro de la première cellule non vide rencontrée en mémoire" dans ton exemple c'est la 16.

Voilà à toi de jouer en copiant correctement la code de nibledispo...

Bonne soirée...

PLV

**nibledispo** · 17/11/2013, 19h54

Bonsoir Marc,

J'ai vu l'autre poste et lui en ai fait la remarque à 19h40.

Quoi que sa demande soit légèrement différente puisqu'il veut dans l'autre post ne copier qu'en D1.

Qu'il s'arrange avec son interlocuteur !

Cordialement,

**casefayere** · 17/11/2013, 19h55

Bonsoir,
je viens de répondre la même chose sur l'autre sujet identique, et j'ai même proposé une autre solution, je ne comprends pas ce que Nonno 94 désire et Marc a raison

De toute manière cette discussion est encore un doublon ‼