Macro pour coller des lignes
Bonjour Dhany,
Merci de ton message.
Pour l'instant tout fonctionne mais je dois faire des tests complémentaires sur le fichier original.
Je te remercies enormement de ton ton temps et des tes connaissances.
Cependant, et afin de m'améliorer sans te déranger, je voudrais etre autonome sur le fait de cacher ou non des lignes avec ton code suivant :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig&, k&, p1$, p2$, p3$
Application.ScreenUpdating = 0
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 4 Then Exit Sub
lig = .Row: If lig < 9 Or lig > n1 Then Exit Sub
v = .Value: k = lig + 1
Select Case lig
Case 9: p1 = IIf(v = "non", "10:13", "14")
Case 14: p1 = IIf(v = "oui", "15", "16")
Case 16: p1 = IIf(v = "oui", "17", "18:20")
Case 18: p1 = IIf(v = "non", "21", "21:27"): k = 21
Case 22 To 27: TestPlg 22, 27: k = 28
If NbNon > 0 Then
p1 = "28"
pourrais tu me le commenter et en prmeier lieu me dire pourquoi ce code remplace celui que j'avais ecrit :
If Range("d9").Value = "non" Then Rows("12:79").EntireRow.Hidden = True??
Merci a toi et bon dernier jour de 2018
Cordialement
Elsouba
Bonjour elsouba,
tu a écrit :en premier lieu me dire pourquoi ce code remplace celui que j'avais écrit ?
ton code initial était celui-ci :
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = 0
Rows("9:613").EntireRow.Hidden = False
If Range("d9").Value = "non" Then Rows("12:79").EntireRow.Hidden = True
If Range("d9").Value = "oui" Then Rows("10:13").EntireRow.Hidden = True
If Range("d10").Value = "non" Then Rows("12:55").EntireRow.Hidden = True
If Range("d14").Value = "oui" Then Rows("16:79").EntireRow.Hidden = True
If Range("d14").Value = "non" Then Rows("15").EntireRow.Hidden = True
If Range("d16").Value = "non" Then Rows("17:19").EntireRow.Hidden = True
If Range("d28").Value = "oui" Then Rows("36:61").EntireRow.Hidden = True
If Range("d28").Value = "non" Then Rows("29:35").EntireRow.Hidden = True
If Range("d30").Value = "oui" Then Rows("37:62").EntireRow.Hidden = True
If Range("d30").Value = "non" Then Rows("31:62").EntireRow.Hidden = True
If Range("d36").Value = "non" Then Rows("37:63").EntireRow.Hidden = True
If Range("d43").Value = "non" Then Rows("44:60").EntireRow.Hidden = True
If Range("d46").Value = "non" Then Rows("47:60").EntireRow.Hidden = True
If Range("d51").Value = "oui" Then Rows("53:61").EntireRow.Hidden = True
If Range("d51").Value = "non" Then Rows("52:61").EntireRow.Hidden = True
Application.ScreenUpdating = -1
End Sub
ça affiche les lignes 9 à 613 ; puis ça affiche certaines lignes selon la valeur "oui" ou "non" des différentes cellules testées ; or tout ce travail est fait à chaque fois qu'une cellule de la feuille est modifiée, quelle que soit cette cellule, donc même si celle-ci n'est pas une des celllules où tu choisis "oui" ou "non".
l'écriture d'une sub événementielle est un peu différente d'une sub classique d'un module standard, et mon code VBA fait le travail uniquement lorsque tu modifies une des cellules où tu choisis "oui" ou "non".
pour info, ta dernière instruction Application.ScreenUpdating = -1 est inutile, car c'est fait automatiquement et implicitement juste avant la sortie de la sub.
dhany
tu a écrit :pourrais-tu me le commenter ?
avant de voir la sub Worksheet_Change(), il faut d'abord voir celle-ci :
Private Sub Workbook_Open()
Application.ScreenUpdating = 0
Dim lm&, plg$: lm = Rows.Count
plg = "D9:D10, D14, D16, D18, D22:D27, " _
& "D30:D33, D36:D43, D46:D49, D54:D56"
With Worksheets("Questionnaire")
.Rows.Hidden = 0: .Range(plg).ClearContents
n1 = .Cells(lm, 4).End(3).Row
n2 = .Cells(lm, 1).End(3).Row
.Rows("10:" & n2).Hidden = -1
End With
End Sub
tu sais déjà qu'elle est exécutée à l'ouverture du classeur.
Application.ScreenUpdating = 0
: évite la mise à jour de l'écran ➯ exécution plus rapide
Dim lm&, plg$
: idem que Dim lm As Long, plg As String
lm = Rows.Count
: ligne maxi : 65536 pour un classeur "Excel 97 - 2003" ; 1 048 576 après
plg = "D9:D10, D14, D16, D18, D22:D27, D30:D33, D36:D43, D46:D49, D54:D56"
:
liste de toutes les cellules où tu saisis "oui" ou "non"
With Worksheets("Questionnaire")
.. End With
: avec la feuille "Questionnaire"
.Rows.Hidden = 0
: on affiche toutes les lignes
.Range(plg).ClearContents
: on efface toutes les cellules de plg ; cela car tu avais écrit :
« y a-t-il une possibilité d'avoir l'ensemble des valeurs des listes déroulantes à "vierge" à l 'ouverture du chantier ? »
n1 = .Cells(lm, 4).End(3).Row
: n1 = n° dernière ligne, selon la colonne D
n2 = .Cells(lm, 1).End(3).Row
: n2 = n° dernière ligne, selon la colonne A
.Rows("10:" & n2).Hidden = -1
: on masque toutes les lignes de 10 à n2
au début de Module1 : Public n1&, n2&
: n1 et n2 sont 2 variables publiques de type Long
elles sont donc visibles à la fois par Workbook_Open() et par Worksheet_Change()
dhany
début du code de Feuil1 (feuille "Questionnaire") :
Option Explicit
: pour forcer la déclaration des variables
Dim NbOui As Byte, NbNon As Byte, v As String * 3
: au niveau Module, déclaration de 3 variables
pour NbOui et NbNon : type Byte = octet ; pour v : chaîne de caractères de longueur fixe, de 3 caractères
Private Sub TestPlg(a&, b&)
: cette sub est privée car elle n'est appelée que par Worksheet_Change()
les valeurs envoyées pour a et b sont 2 numéros de ligne.
Dim i&: NbOui = 0: NbNon = 0
: variable i de type Long ; NbOui et NbNon sont mis à 0.
For i = a To b
.. Next i
: boucle i de a à b
v = Cells(i, 4)
: v est la valeur de la cellule en ligne i, colonne D
If v = "oui" Then NbOui = NbOui + 1
: si v contient "oui", NbOui est incrémenté de 1
If v = "non" Then NbNon = NbNon + 1
: si v contient "non", NbNon est incrémenté de 1
ainsi, le but de cette sub est de compter le nombre de "oui" et de "non" entre les lignes a et b.
la sub Worksheet_Change() fera son travail en utilisant les valeurs de NbOui et NbNon.
dhany
après exécution de Workbook_Open(), l'ensemble des valeurs des listes déroulantes sont vierges, et seules les 9 premières lignes sont affichées.
Private Sub Worksheet_Change(ByVal Target As Range)
: voici enfin la sub Worksheet_Change()
Dim lig&, k&, p1$, p2$, p3$
: lig et k : de type Long : p1, p2 et p3 : de type chaîne de caractères
Application.ScreenUpdating = 0
: évite la mise à jour de l'écran ➯ exécution plus rapide
With Target
.. End With
: avec Target, qui est la plage où une cellule a été modifiée
If .CountLarge > 1 Then Exit Sub
: on sort si cette plage est de plus d'une cellule
➯ on fait la suite seulement si une seule cellule a été modifiée
If .Column <> 4 Then Exit Sub
: on sort si c'est pas en colonne D
➯ on fait la suite seulement si la cellule modifiée est en colonne D
lig = .Row
: lig = ligne de la cellule modifiée
If lig < 9 Or lig > n1 Then Exit Sub
: sortie si ligne au-dessus de 9 ou en dessous de n1
➯ on fait la suite seulement si la ligne est entre 9 et n1 inclus
v = .Value
: v : valeur de la cellule modifiée
k = lig + 1
: k : n° ligne + 1 = ligne juste en dessous de la ligne de la cellule modifiée,
car c'est de cette ligne k à la ligne n2 qu'on masquera les lignes (juste après le End Select)
en effet, la fin de la sub est celle-ci :
Rows(k & ":" & n2).Hidden = -1 ' masque les lignes k à n2
If p1 <> "" Then Rows(p1).Hidden = 0 ' si p1 n'est pas vide, affiche la plage de lignes p1
If p2 <> "" Then Rows(p2).Hidden = 0 ' si p2 n'est pas vide, affiche la plage de lignes p2
If p3 <> "" Then Rows(p3).Hidden = 0 ' si p3 n'est pas vide, affiche la plage de lignes p3
tout le travail du Select Case
.. End Select
est d'indiquer dans p1, p2, ou p3, les plages de lignes à afficher
(cela selon diverses conditions) ; c'est un gros morceau, que j'détaillerai après ma pause-repas.
dhany
suite de l'explication de la sub Worksheet_Change() :
v = .Value: k = lig + 1
Select Case lig
Case 9: p1 = IIf(v = "non", "10:13", "14")
Case 14: p1 = IIf(v = "oui", "15", "16")
Case 16: p1 = IIf(v = "oui", "17", "18:20")
Case 18: p1 = IIf(v = "non", "21", "21:27"): k = 21
Case 22 To 27: TestPlg 22, 27: k = 28
If NbNon > 0 Then
p1 = "28"
If [D22] = "non" Then p2 = "36": p3 = "61"
End If
If NbOui = 6 Then p1 = "29:30"
Case Else: Exit Sub
End Select
Rows(k & ":" & n2).Hidden = -1
If p1 <> "" Then Rows(p1).Hidden = 0
If p2 <> "" Then Rows(p2).Hidden = 0
If p3 <> "" Then Rows(p3).Hidden = 0
à ce stade : la cellule modifiée est forcément une cellule de la colonne D, ligne 9 à n1 inclus
lig contient le n° de la ligne de la cellule modifiée, donc si c'est 9, c'est D9 qui est modifié
v contient la valeur de la cellule modifiée : "oui" ou "non" ; ou rien si cellule vide
k contient le n° de la ligne qui suit celle de la cellule modifiée
Case 9: p1 = IIf(v = "non", "10:13", "14")
: pour D9 : si v est "non", p1 vaut "10:13" ; sinon, p1 vaut 14 ; conséquence : après le End Select, on masque les lignes k à n1, donc 10 à n1 ; puis on affiche les lignes 10 à 13 ; ou la seule ligne 14.
Case 14: p1 = IIf(v = "oui", "15", "16")
: pour D14 : on masquera 15 à n1, puis : si v est "oui", on affichera la ligne 15 ; sinon on affichera la ligne 16.
Case 16: p1 = IIf(v = "oui", "17", "18:20")
: pour D16 : on masquera 17 à n1, puis : si v est "oui", on affichera la ligne 17 ; sinon on affichera les lignes 18:20.
Case 18: p1 = IIf(v = "non", "21", "21:27"): k = 21
: pour D18 : attention : sans k = 21, on masquerait 19 à n1 ; mais les lignes 19 et 20 doivent rester visibles ; donc avec k = 21, on masquera 21 à n1, puis : si v est "non", on affichera la ligne 21 ; sinon on affichera les lignes 21:27.
Case 22 To 27: TestPlg 22, 27: k = 28
If NbNon > 0 Then
p1 = "28"
If [D22] = "non" Then p2 = "36": p3 = "61"
End If
If NbOui = 6 Then p1 = "29:30"
Case 22 To 27:
: pour D22 à D27
TestPlg 22, 27
: compter le nombre de "oui" et de "non" des lignes 22 à 27
k = 28
: on masquera de 28 à n1
If NbNon > 0 Then
.. End If
: si y'a au moins un "non" :
* p1 = "28"
: on affichera la ligne 28
* If [D22] = "non" Then p2 = "36": p3 = "61"
: si "non" en D22, on affichera les lignes 36 et 61
If NbOui = 6 Then p1 = "29:30"
: si y'a 6 "oui", on affichera les lignes 29:30
à part le Case Else, tous les autres Case sont similaires à un de ceux déjà décrits.
fin d'l'explication ; bonne chance pour ton adaptation, et bonne année 2019 !
dhany
Bonjour Dhany,
Tout d'abord j'espère ne pas etre la cause d'un travail tardif ( Re: macro pour coller des lignesCitation dhany
par dhany » Aujourd’hui, 04:34.....)
Merci pour les explications, je vais m'entrainer et modifier quelques lignes afin de mieux comprendre ton code (la pratique sans aide est plus efficace pour acquérir les données).
Cependant, si j'ai un moindre souci je me permettrais de revenir vers toi.
Une belle année 2019 à toi également
merci pour ton retour d'infos, et peut-être à bientôt !
dhany
Re-bonjour Dhany,
De retour plus vite que prevu....
Je comprends mieux avec tes explication.
Cependant, j'ai un souci
Dans ton code, si j'ai un non en D22 et/ou D23et/ou D24 et/ou D25et/ou D26 et/ou D27 je dois avoir que la ligne 36 qui apparait.
A l'heure actuelle, cela fonctionne uniquement avec D22 mais pas les autres lignes.
Faut il écrire un code pour chaque ligne comme tu as ecrit pour D22?
du style :
Case 22 To 27: TestPlg 22, 27: k = 28
If NbNon > 0 Then
p1 = "28"
If [D22] = "non" Then p2 = "36"
If [D23] = "non" Then p2 = "36"
If [D24] = "non" Then p2 = "36"
If [D25] = "non" Then p2 = "36"
If [D26] = "non" Then p2 = "36"
If [D27] = "non" Then p2 = "36"
End If
If NbOui = 6 Then p1 = "29:30"
et ce la fonctionne mais est-ce la bonne demarche?.
Je voudrais par contre copier la cellule A1 de questionnaire dans la cellule A1 de Edition en meme temp que la requete de copie generale avec ctrl E
Une petite aide serait la bienvenue.
Merci à toi
Bonjour a Dhany et au forum,
Dhany m'a été d'un grand secours et j'ai voulu ajouter à son code une copie de cellule :
(en souligné mon code ajouté)
Option Explicit
Public n1&, n2&
Dim sh As Worksheet, lg2&
[b][i][u]Sub Macro1()
Worksheets("Edition").Range("A1").Value = Worksheets("Questionnaire").Range("A1").Value
End Sub[/u][/i][/b]
Private Sub Job(col%)
Dim lg1&: lg2 = lg2 + 2
For lg1 = 2 To Cells(Rows.Count, col).End(xlUp).Row
If Rows(lg1).Hidden = 0 Then
With Cells(lg1, col)
If .Value <> "" And .Value <> "0" _
Then sh.Cells(lg2, 1) = .Value: lg2 = lg2 + 1
End With
End If
Next lg1
End Sub
Sub CpyData()
'but : copie en feuille "Edition", tout en 1ère colonne
'sortie si la feuille active n'est pas "Questionnaire"
If ActiveSheet.Name <> "Questionnaire" Then Exit Sub
Dim TA, TB, k%, i As Byte
TA = Array(15, 13, 14) 'colonnes O, M, N
TB = Array(23, 3, 45) 'bleu, rouge, orange
Set sh = Worksheets("Edition") 'sh : feuille "Edition"
With sh 'avec sh, donc avec la feuille "Edition"
.Columns(1).Clear 'on efface toute la 1ère colonne
lg2 = 3 '3 => la 1ère ligne sera : 3 + 2 = 5
For i = 0 To UBound(TA)
With .Cells(lg2 + 1, 1)
.Font.Bold = -1: k = TA(i)
.Font.ColorIndex = TB(i)
.Value = Cells(1, k)
End With
Job k
Next i
.Select
End With
[i][b][u]Call Macro1[/u][/b][/i]
End Sub
un avis sur mon code et ma demarche
Merci à vous
Bonjour Elsouba,
j'étais pas prêt pour te répondre : parfois, j'étais occupé par des affaires personnelles ou d'autres exos, parfois j'étais tout simplement trop fatigué et j'devais aller m'reposer !
attention : ne fais pas les modifs indiquées ci-dessous, car c'est déjà fait dans le fichier joint en bas de ce post.
pour le code VBA de ton dernier post :
1) inutile d'utiliser les balises gras italique souligné : tu peux voir qu'elles ne fonctionnent pas à l'intérieur des balises de code.
2) ce que tu as rajouté est bon : ta Macro1() fait effectivement la copie de A1 que tu voulais faire, et tu as bien fait de mettre l'appel de cette sub après l'instruction .Columns(1).Clear, sinon, A1 aurait été effacé ; par contre, il y a beaucoup plus simple, sans ajouter de nouvelle macro, et avec une seule instruction courte ; juste après .Columns(1).Clear, j'ai mis : .[A1] = [A1] 'A1 : de "Questionnaire" à "Edition"
With sh 'avec sh, donc avec la feuille "Edition"
.Columns(1).Clear 'on efface toute la 1ère colonne
.[A1] = [A1] 'A1 : de "Questionnaire" à "Edition"
lg2 = 3 '3 => la 1ère ligne sera : 3 + 2 = 5
For i = 0 To UBound(TA)
With .Cells(lg2 + 1, 1)
.Font.Bold = -1: k = TA(i)
.Font.ColorIndex = TB(i)
.Value = Cells(1, k)
End With
Job k
Next i
.Select
End With
[quote="dans ton post du 2 janvier à 16:59, tu"]Dans ton code, si j'ai un "non" en D22 et/ou D23 et/ou D24 et/ou D25 et/ou D26 et/ou D27, je dois avoir que la ligne 36 qui apparaît.
A l'heure actuelle, cela fonctionne uniquement avec D22 mais pas les autres lignes.[/quote]
je trouve ça bizarre, car dans le code VBA du fichier précédent, voici la partie concernée :
Case 22 To 27: TestPlg 22, 27: k = 28
If NbNon > 0 Then
p1 = "28"
If [D22] = "non" Then p2 = "36": p3 = "61"
End If
If NbOui = 6 Then p1 = "29:30"
ça fait que pour D22 (ainsi que pour D23 à D27), si y'a au moins un "non", alors ça affiche les lignes 28, 36, et 61 ; et pas seulement la ligne 36 !
pour l'ensemble de ton exo, tu n'as pas précisé suffisamment clairement quelles lignes devaient être affichées quand on modifie une valeur "oui" ou "non" d'une liste déroulante (et pour certaines, j'ai passé un bon moment à chercher !) ; exemple sur l'image ci-dessus :
a) en A28, il y a le texte : « affirmation si 1 seul non entre 6,1 et 6,6 » car la formule est :
=SI(NBVAL(D22:D27)=0;"";SI(ET(D22="oui";D23="oui"; D24="oui"; D25="oui";D26="oui";D27="oui");E28; "affirmation si 1 seul non entre 6,1 et 6,6"))
donc d'après cette formule : ça affiche le texte de E28 si y'a 6 "oui" ; sinon, c'est la phrase citée ; ça fait que cette phrase aurait plutôt dû être :
et comme en B36 il y a le texte « Message de fin de cet outil », j'ai pensé que c'était une consigne pour dire : « il faut afficher la ligne 61 ».
bon, quoi qu'il en soit, pour faire ta nouvelle demande d'afficher uniquement la ligne 36, le bout de code VBA précédent devient tout simplement :
Case 22 To 27: TestPlg 22, 27: k = 28
If NbNon > 0 Then p1 = "36"
If NbOui = 6 Then p1 = "29:30"
note que la 1ère ligne et la 3ème ligne sont restées identiques (je les ai mises juste pour que tu puisses mieux repérer l'endroit d'la modif).
et surtout pas dupliquer inutilement les lignes pour les cas 23 à 27 !!!
voilà, j'espère que toutes ces infos t'aideront à avancer ; maint'nant, j'vais aussi lire les MP qu'tu m'as envoyés.
j't'enverrai un MP si j'ai quelque chose d'utile à ajouter qui n'est pas déjà écrit dans ce très long post.
voici ton nouveau fichier :
dhany
Merci beaucoup de Dahny,
Je ne suis qu un seau m abreuvant dans ton puit de connaissance.
Merci de tes remarques et modifications.
Si je voulais ajouter des images à la suite des informations copiés dans l onglet édition en fonction de mot apparaissant dans la colonne A de l onglet édition, cela serait il possible ?
Ex : un mot comme "test" apparaît dans la colonne A suite à ta macro copiant les colonnes m n et o du questionnaire. Je voudrais qu une image apparaisse en fonction de ce mot à la fin des information de l onglet édition.
Et cela pour 4 mots clés
Possible je suppose mais avec du vba?
Cordialement
tu a écrit :Je ne suis qu'un seau m'abreuvant dans ton puits de connaissance.
merci du compliment, mais j'connais pas tout quand même, hein !
j'ai répondu à tes MP, et maint'nant j'vais faire une très longue pause : j'ai très faim car ça creuse l'appétit, le VBA !
dhany