Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Comment faire pour conbiner deux macro en une seule

Comment faire pour conbiner deux macro en une seule

13 réponses
Avatar
Daniel Pelletier
Bonjour à tous

Je veut l'intégrer les deux macros en une seul.

Dans la première macro, on vérifie si l'utilisateur n'a pas oublier d'entré
une donné dans la colonne "E"
et on l'oblige de la faire.
Tous cela sur tout les ligne entre 18 et 37 ième ligne.

Dans la deuxième macro on copie les valeur de la ligne (de B à M) sur une
autre feuille("Base").
Je voudrait copie les valeur sur les même ligne que la première macro.

En résumé la Macro vérifie si il y a une entré dans une des deux première
colonne et si il n'y a pas d'entré en "E" oblige l'utilisateur a entré une
donné et puis copie chacune des ligne dans la feuille ("Base").

Merci pour votre aide :-)

Première MACRO

ActiveSheet.Unprotect
Dim l As Long, c As Integer, oblig As Label
ActiveSheet.Unprotect
oblig:
For c = 2 To 3
For l = 18 To 37
If Cells(l, c).Value <> "" Then
If Cells(l, 5) = "" Then
Range("E" & l).Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& l - 17 & vbNewLine _
& " saisissez la maintenant" _
& " ci dessous", "PRIORITÉ est obligatoire", , "5000",
"2000")
GoTo oblig
End If
End If
Next l
Next c

Deuxième MACRO

Sub CopierUnRange()______

Dim Rg As Range, Rg1 As Range
With Worksheets("Feuille_insp")
If .Range("E18") <> "" Then
Set Rg = .Range("B18:m18")
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
End If
End With
Set Rg = Nothing: Set Rg1 = Nothing
End Sub
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
michdenis
La boucle fait ceci :

Pour chacune des lignes (18 à 37) de la feuille Feuille_insp

Si la colonne B " ET " C ne sont pas dûment rempli, la macro passe à la ligne suivante. Aucune copie, aucune
vérification à savoir si la colonne F de la même ligne est remplie ou non.


Si les 2 colonnes B " ET " C de la ligne sont remplies, Alors il y a vérification du contenu de la colonne F. Si elle
est vide, l'usager sera obligé d'insérer une donnée pour continuer et c'est seulement après avoir rempli cette cellule
qu'il y a copie de la ligne entre la colonne B et M vers l'autre feuille.

Et ces instructions, c'est ce que j'ai pu décoder de ce message :


" Et non, je ne veut pas faire remplir tout les champ. Je m'explique l'utilisateur si n'a pas entré de donné dans
colonne B ou C la macro passe a la ligne suivante. et si il a entré en C ou B ou les deux, il faut que E est une donné
avant de copier la ligne dans l'autre feuille("Base") "

Moi, je mets fin à mon intervention sur ce fil. Il y a sûrement d'autres usagers de ce groupe de discussion qui
prendront la relève !

S.V.P. Ne m'envoie pas ton fichier !


Salutations!










"Daniel Pelletier" a écrit dans le message de news:
Salut Michdenis

Rein ne ce passe !! :-((
Je te fait parvenir mon fichier zip

"michdenis" a écrit dans le message de
news:
Sub Vérification()

Dim Rg As Range, C As Range, A As Integer

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
If C.Offset(, 3) <> "" And C.Offset(, -2) <> "" Then
Do
If C = "" Then
C = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "2000 ou 5000")
End If
If C <> "" Then
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C <> ""
End If
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub

Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
'-------------------------------------------















"Daniel Pelletier" a écrit dans le message de
news:%

Et non, je ne veut pas faire remplir tout les champ.
Je m'explique l'utilisateur si n'a pas entré de donné dans colonne B ou C
la

macro passe a la ligne suivante.
et si il a entré en C ou B ou les deux,
il faut que E est une donné avant de copier la ligne dans l'autre
feuille("Base").

Merci

"michdenis" a écrit dans le message de
news:uSh5q$
Bonjour Daniel,

Les 3 champs devront être rempli. Il pourra le faire en renseignant
directement la boîte de dialogue.


'-------------------------------------------
Sub Vérification()

Dim Rg As Range, C As Range, A As Integer

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
For A = 3 To 1 Step -1
If A = 1 Then A = -1
Do
If C.Offset(, -A) = "" Then
C.Offset(, -A) = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "2000 ou 5000")
End If
If A = -1 And C.Offset(, -A) <> "" Then
'Appel de l'autre procédure
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C.Offset(, -A) <> ""
Next
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub
'----------------------------------------
Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
'-------------------------------------------


Salutations!






"Daniel Pelletier" a écrit dans le message de
news:

Je mexcuse de l'oublie.
L'utilisateur doit avoir entré au moin une donné (il a choix de prendre
les

déroulers de validation ou ce qu'il veut)
dans colonne B ou C ou les deux et si il oublie d'entré en E la macro
lui


impose.
merci

"michdenis" a écrit dans le message de
news:uu7$
Bien, je me suis basé sur ceci issu de ton premier message :

"Dans la première macro, on vérifie si l'utilisateur n'a pas oublier
d'entré

une donné dans la colonne "E"
et on l'oblige de la faire.
Tous cela sur tout les ligne entre 18 et 37 ième ligne."


Si je comprends bien, ce n'est pas seulement la colonne E mais B, C et
E



des lignes 18 à 37 qui doivent être
renseignées.

Est-ce que dans ces cellules, il y a un type de données particulières
où



si l'usager peut se permettre d'inscrire
n'importe quoi ?


Salutations!



"Daniel Pelletier" a écrit dans le message de
news:%

ReBonjour Michdenis

Ca fonctionne en partie , la macro copie bien dans l'autre feuille
Mais elle n'arrête pas même si l'utilisateur na rien entré dans les
deux



première colonne (B & C).

Elle doit coipier les ligne qui on une entrée dans B ou C.

Merci

"michdenis" a écrit dans le message de
news:%
Bonjour Daniel,

Je n'ai pas tout compris ce que tu voulais, mais j'ai imbriqué les 2
procédures :


Tu copies ces 2 procédures dans un module standard, et tu appelles
seulement la procédure : Vérification()


'-------------------------------------------
Sub Vérification()

Dim Rg As Range, C As Range

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
Do
If C = "" Then
C.Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "2000 ou 5000")
End If
If C <> "" Then
'Appel de l'autre procédure
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C.Value <> ""
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub
'-------------------------------------------
Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
'-------------------------------------------



Salutations!






"Daniel Pelletier" a écrit dans le message
de




news:
Bien Bonjour Michdenis
1: **** ça se passe sur quelle feuille de calcul ?
sur la feuille ou il y a le bouton qui démar la macro
("Feuille_insp")





2: **** Suppose que l'utilisateur ne veut rien savoir ... de quelle
façon


doit-on mettre fin à la procédure, le cas échéant
Non il doit entrée une donné !! (ces ligne de code je voulait les
mettre


parceque cela inserer la date et l'heure dans la colonne "L".
3: Dans la procédure 1 ces avec cela que je vérifie si
l'utilisateur




a
oublier la colonne "E" sur chaqu'une des ligne .

Merci


"michdenis" a écrit dans le message de
news:
Bonjour Daniel,

Ta macro No1 manque un peu de précision :

"Dans la première macro, on vérifie si l'utilisateur n'a pas
oublier





d'entré une donné dans la colonne "E" et on
l'oblige de la faire. Tous cela sur tout les ligne entre 18 et 37
ième




ligne."
**** ça se passe sur quelle feuille de calcul ?

"et on l'oblige"
**** Suppose que l'utilisateur ne veut rien savoir ... de quelle
façon




doit-on mettre fin à la procédure, le cas échéant
?

Dans ta procédure No1, tu écris :
For C = 2 To 3
For L = 18 To 37
If Cells(L, C).Value <> "" Then
If Cells(L, 5) = "" Then

**** If Cells(L, C).Value <> "" représente un test sur la cellule
B18




...
Pourquoi ? Tu ne donnes pas l'explication
dans tes commentaires !

**** Même chose pour ceci : If Cells(l, 5) = "" Then : Pourquoi
ce




test
?



Salutations!









"Daniel Pelletier" a écrit dans le message
de




news:
Bonjour à tous

Je veut l'intégrer les deux macros en une seul.

Dans la première macro, on vérifie si l'utilisateur n'a pas
oublier





d'entré
une donné dans la colonne "E"
et on l'oblige de la faire.
Tous cela sur tout les ligne entre 18 et 37 ième ligne.

Dans la deuxième macro on copie les valeur de la ligne (de B à M)
sur




une
autre feuille("Base").
Je voudrait copie les valeur sur les même ligne que la première
macro.





En résumé la Macro vérifie si il y a une entré dans une des deux
première


colonne et si il n'y a pas d'entré en "E" oblige l'utilisateur a
entré




une
donné et puis copie chacune des ligne dans la feuille ("Base").

Merci pour votre aide :-)

Première MACRO

ActiveSheet.Unprotect
Dim l As Long, c As Integer, oblig As Label
ActiveSheet.Unprotect
oblig:
For c = 2 To 3
For l = 18 To 37
If Cells(l, c).Value <> "" Then
If Cells(l, 5) = "" Then
Range("E" & l).Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& l - 17 & vbNewLine _
& " saisissez la maintenant" _
& " ci dessous", "PRIORITÉ est obligatoire", ,
"5000",


"2000")
GoTo oblig
End If
End If
Next l
Next c

Deuxième MACRO

Sub CopierUnRange()______

Dim Rg As Range, Rg1 As Range
With Worksheets("Feuille_insp")
If .Range("E18") <> "" Then
Set Rg = .Range("B18:m18")
With Worksheets("Base")
Set Rg1 = .Range("A" &
.Range("A65536").End(xlUp)(2).Row)




Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
End If
End With
Set Rg = Nothing: Set Rg1 = Nothing
End Sub


























Avatar
Daniel Pelletier
Merci beaucoup de t'on aide :-)

"michdenis" a écrit dans le message de
news:
La boucle fait ceci :

Pour chacune des lignes (18 à 37) de la feuille Feuille_insp

Si la colonne B " ET " C ne sont pas dûment rempli, la macro passe à la
ligne suivante. Aucune copie, aucune

vérification à savoir si la colonne F de la même ligne est remplie ou non.


Si les 2 colonnes B " ET " C de la ligne sont remplies, Alors il y a
vérification du contenu de la colonne F. Si elle

est vide, l'usager sera obligé d'insérer une donnée pour continuer et
c'est seulement après avoir rempli cette cellule

qu'il y a copie de la ligne entre la colonne B et M vers l'autre feuille.

Et ces instructions, c'est ce que j'ai pu décoder de ce message :


" Et non, je ne veut pas faire remplir tout les champ. Je m'explique
l'utilisateur si n'a pas entré de donné dans

colonne B ou C la macro passe a la ligne suivante. et si il a entré en C
ou B ou les deux, il faut que E est une donné

avant de copier la ligne dans l'autre feuille("Base") "

Moi, je mets fin à mon intervention sur ce fil. Il y a sûrement d'autres
usagers de ce groupe de discussion qui

prendront la relève !

S.V.P. Ne m'envoie pas ton fichier !


Salutations!










"Daniel Pelletier" a écrit dans le message de
news:

Salut Michdenis

Rein ne ce passe !! :-((
Je te fait parvenir mon fichier zip

"michdenis" a écrit dans le message de
news:
Sub Vérification()

Dim Rg As Range, C As Range, A As Integer

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
If C.Offset(, 3) <> "" And C.Offset(, -2) <> "" Then
Do
If C = "" Then
C = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "2000 ou 5000")
End If
If C <> "" Then
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C <> ""
End If
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub

Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
'-------------------------------------------















"Daniel Pelletier" a écrit dans le message de
news:%

Et non, je ne veut pas faire remplir tout les champ.
Je m'explique l'utilisateur si n'a pas entré de donné dans colonne B ou
C


la
macro passe a la ligne suivante.
et si il a entré en C ou B ou les deux,
il faut que E est une donné avant de copier la ligne dans l'autre
feuille("Base").

Merci

"michdenis" a écrit dans le message de
news:uSh5q$
Bonjour Daniel,

Les 3 champs devront être rempli. Il pourra le faire en renseignant
directement la boîte de dialogue.


'-------------------------------------------
Sub Vérification()

Dim Rg As Range, C As Range, A As Integer

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
For A = 3 To 1 Step -1
If A = 1 Then A = -1
Do
If C.Offset(, -A) = "" Then
C.Offset(, -A) = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "2000 ou 5000")
End If
If A = -1 And C.Offset(, -A) <> "" Then
'Appel de l'autre procédure
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C.Offset(, -A) <> ""
Next
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub
'----------------------------------------
Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
'-------------------------------------------


Salutations!






"Daniel Pelletier" a écrit dans le message de
news:

Je mexcuse de l'oublie.
L'utilisateur doit avoir entré au moin une donné (il a choix de
prendre



les
déroulers de validation ou ce qu'il veut)
dans colonne B ou C ou les deux et si il oublie d'entré en E la macro
lui


impose.
merci

"michdenis" a écrit dans le message de
news:uu7$
Bien, je me suis basé sur ceci issu de ton premier message :

"Dans la première macro, on vérifie si l'utilisateur n'a pas oublier
d'entré

une donné dans la colonne "E"
et on l'oblige de la faire.
Tous cela sur tout les ligne entre 18 et 37 ième ligne."


Si je comprends bien, ce n'est pas seulement la colonne E mais B, C
et




E
des lignes 18 à 37 qui doivent être
renseignées.

Est-ce que dans ces cellules, il y a un type de données
particulières




où
si l'usager peut se permettre d'inscrire
n'importe quoi ?


Salutations!



"Daniel Pelletier" a écrit dans le message
de




news:%
ReBonjour Michdenis

Ca fonctionne en partie , la macro copie bien dans l'autre feuille
Mais elle n'arrête pas même si l'utilisateur na rien entré dans les
deux



première colonne (B & C).

Elle doit coipier les ligne qui on une entrée dans B ou C.

Merci

"michdenis" a écrit dans le message de
news:%
Bonjour Daniel,

Je n'ai pas tout compris ce que tu voulais, mais j'ai imbriqué les
2





procédures :

Tu copies ces 2 procédures dans un module standard, et tu appelles
seulement la procédure : Vérification()


'-------------------------------------------
Sub Vérification()

Dim Rg As Range, C As Range

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
Do
If C = "" Then
C.Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "2000 ou 5000")
End If
If C <> "" Then
'Appel de l'autre procédure
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C.Value <> ""
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub
'-------------------------------------------
Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
'-------------------------------------------



Salutations!






"Daniel Pelletier" a écrit dans le message
de




news:
Bien Bonjour Michdenis
1: **** ça se passe sur quelle feuille de calcul ?
sur la feuille ou il y a le bouton qui démar la macro
("Feuille_insp")





2: **** Suppose que l'utilisateur ne veut rien savoir ... de
quelle





façon
doit-on mettre fin à la procédure, le cas échéant
Non il doit entrée une donné !! (ces ligne de code je voulait
les





mettre
parceque cela inserer la date et l'heure dans la colonne "L".
3: Dans la procédure 1 ces avec cela que je vérifie si
l'utilisateur




a
oublier la colonne "E" sur chaqu'une des ligne .

Merci


"michdenis" a écrit dans le message de
news:
Bonjour Daniel,

Ta macro No1 manque un peu de précision :

"Dans la première macro, on vérifie si l'utilisateur n'a pas
oublier





d'entré une donné dans la colonne "E" et on
l'oblige de la faire. Tous cela sur tout les ligne entre 18 et
37






ième
ligne."
**** ça se passe sur quelle feuille de calcul ?

"et on l'oblige"
**** Suppose que l'utilisateur ne veut rien savoir ... de quelle
façon




doit-on mettre fin à la procédure, le cas échéant
?

Dans ta procédure No1, tu écris :
For C = 2 To 3
For L = 18 To 37
If Cells(L, C).Value <> "" Then
If Cells(L, 5) = "" Then

**** If Cells(L, C).Value <> "" représente un test sur la
cellule






B18
...
Pourquoi ? Tu ne donnes pas l'explication
dans tes commentaires !

**** Même chose pour ceci : If Cells(l, 5) = "" Then :
Pourquoi






ce
test
?



Salutations!









"Daniel Pelletier" a écrit dans le
message






de
news:
Bonjour à tous

Je veut l'intégrer les deux macros en une seul.

Dans la première macro, on vérifie si l'utilisateur n'a pas
oublier





d'entré
une donné dans la colonne "E"
et on l'oblige de la faire.
Tous cela sur tout les ligne entre 18 et 37 ième ligne.

Dans la deuxième macro on copie les valeur de la ligne (de B à
M)






sur
une
autre feuille("Base").
Je voudrait copie les valeur sur les même ligne que la première
macro.





En résumé la Macro vérifie si il y a une entré dans une des deux
première


colonne et si il n'y a pas d'entré en "E" oblige l'utilisateur a
entré




une
donné et puis copie chacune des ligne dans la feuille ("Base").

Merci pour votre aide :-)

Première MACRO

ActiveSheet.Unprotect
Dim l As Long, c As Integer, oblig As Label
ActiveSheet.Unprotect
oblig:
For c = 2 To 3
For l = 18 To 37
If Cells(l, c).Value <> "" Then
If Cells(l, 5) = "" Then
Range("E" & l).Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& l - 17 & vbNewLine _
& " saisissez la maintenant" _
& " ci dessous", "PRIORITÉ est obligatoire",
,






"5000",
"2000")
GoTo oblig
End If
End If
Next l
Next c

Deuxième MACRO

Sub CopierUnRange()______

Dim Rg As Range, Rg1 As Range
With Worksheets("Feuille_insp")
If .Range("E18") <> "" Then
Set Rg = .Range("B18:m18")
With Worksheets("Base")
Set Rg1 = .Range("A" &
.Range("A65536").End(xlUp)(2).Row)




Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) Rg.Value
End With
End If
End With
Set Rg = Nothing: Set Rg1 = Nothing
End Sub































Avatar
Daniel Pelletier
Bonjour Michdenis

Ce matin tous va très bien .

la macro exécute comme prévu.
J'ai changer
If C.Offset(, 3) <> "" And C.Offset(, -2) <> "" Then
pour
If C.Offset(, -3) <> "" Or C.Offset(, -2) <> "" Then
cela donne:
si B ou C est pas vide demande une entré pour E puis copie sur un autre
feuille.

Un gros Merci :-))))))))))))))))))))))))))))))))))))))))))))))
je m'excuse encore de ne pas être tousjour clair mais
je gagne beaucoup de connaissances et
que d'heure sauver a chercher (pour ne pas dire de découragement).




Sub Vérification()

Dim Rg As Range, C As Range, A As Integer

With Worksheets("Feuille_insp")
.Unprotect
Set Rg = .Range("E18:E37")

For Each C In Rg
If C.Offset(, -3) <> "" Or C.Offset(, -2) <> "" Then
Do
If C = "" Then
C = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& C.Row & vbNewLine _
& " saisissez la maintenant" _
& " ci-dessous", "PRIORITÉ est " & _
"obligatoire", "3")
End If
If C <> "" Then
CopierUnRange C.Offset(, -3).Resize(, 12)
End If
Loop Until C <> ""
End If
Next
.Protect
End With
Set Rg = Nothing: Set C = Nothing
End Sub

Sub CopierUnRange(Rg As Range)

Dim Rg1 As Range
With Worksheets("Base")
Set Rg1 = .Range("A" & .Range("A65536").End(xlUp)(2).Row)
Rg.Copy Rg1
Rg1.Resize(Rg.Rows.Count, Rg.Columns.Count) = Rg.Value
End With
Set Rg1 = Nothing
End Sub
1 2