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 ! ce matin, j'ai terminé un autre exo urgent, puis j'ai fait une longue pause ; et j'suis maint'nant en forme pour me remettre sur ton dossier.

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.


screen 1

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 !

screen 2

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 ».

screen 3

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 :

5testv3excel.zip (39.33 Ko)

dhany

Merci beaucoup de Dahny,

Je ne suis qu un seau m abreuvant dans ton puit de connaissance. ne voulant pas mourir de soif je t ai souvent sollicité.

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 ! et y'en a d'autres sur le forum qui sont meilleurs que moi !

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

Rechercher des sujets similaires à "macro coller lignes"