XL 2013 Déplacer cellule après avoir caché des colonne sous conditions

flstyle

XLDnaute Nouveau
Bonjour à tous,



J’ai un souci avec mon code VBA, après beaucoup de tentatives je n'arrive pas à trouver la solution.

Je vous explique; je souhaite que l'utilisateur de ce tableau puisse à sa guise remplir "Oui", ou "Non" pour pouvoir remplir une partie du tableau.

Pour cela le code VBA fonctionne bien.
Dès que l'utilisateur sélectionne "Non", une partie se masque (et vis-versa).

Malheureusement une partie que je ne souhaite pas masquer le fait malgré elle (F4:M10).

Je souhaiterais que cette partie reste visible (au milieu de la feuille, comme avant si c'est possible; c'est ce qui ma poussé dans mon code ci-joint à le séparer dans mon .cut)

Voilà ce que j'ai déjà fait. Il me manque peu pour réussir, et je suis sure que vous pourriez m'aider.



Merci par avance.






Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

temp = Array("Oui", "Non")
  If Not Application.Intersect(Target, Range("E12:E12")) Is Nothing Then
  If Target.Count > 1 Then Exit Sub

    With Target
  p = Application.Match(Target, temp, 0)
  If Not IsError(p) Then
    If p = UBound(temp) + 1 Then p = 0
  Else
    p = 0
   
   
  End If
  Target = temp(p)
  End With
  End If

    If Range("E12") = "Oui" Then
Range(Cells(14, 6), Cells(109, 12)).EntireColumn.Hidden = False
    Else
Range(Cells(14, 6), Cells(109, 12)).EntireColumn.Hidden = True
    End If
  
      If Range("E12") = "Oui" Then
     
For i = 4 To 10 'pour i dont la valeur va de 4 à 10
    Range("F:I" & i).Select
    Selection.Cut
    Range("B:E" & i).Select
    ActiveSheet.Paste = False
    Else
     Range("F:I" & i).Select
    Selection.Cut
    Range("B:E" & i).Select
    ActiveSheet.Paste = True
   
   
    Next i 'incrémentation
   
     Range("J:M" & i).Select
    Selection.Cut
    Range("M:P" & i).Select
    ActiveSheet.Paste = False
    Else
    Range("J:M" & i).Select
    Selection.Cut
    Range("M:P" & i).Select
    ActiveSheet.Paste = True
   
   
   
    End If
    
     
End Sub
 

Pièces jointes

  • Copie de Rapport de controle Demo.xlsm
    87.6 KB · Affichages: 53

Discussions similaires

Réponses
7
Affichages
528

Statistiques des forums

Discussions
315 093
Messages
2 116 138
Membres
112 669
dernier inscrit
Guigui2502