XL 2019 Date

[le___destin]

Je veux créer une colone d'un tableau lorsque je rempli la premiere case emplie automatiquement les autre cellule jusqu'à la date du fin du moi

 

[le___destin]

Les cellule L4 L5 L6 .. du feuille1
Si l4 =0 et l5=0
Mai si tu remplis l6 puis l5 pui l4 ca marche

 

[danielco]

Je ne comprends pas pourquoi tu me parles de ces cellules qui ne sont pas dans le tableau ?

Fais un effort pour bien m'expliquer en détail. Je passe trop de temps à essayer de comprendre.

Daniel

 

[le___destin]

 

[le___destin]

la fusion de (G18:M20) ne s'applique plus malgré que F18.F19F20 = "- -"

 

[le___destin]

ouvrier pas souvrier

 

[danielco]

Compris.

Essaie :

Private Sub Worksheet_Calculate()
Dim C As Range, ResC As String, Cellule As Range
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For Each C In Range("F12", Cells(Rows.Count, 6).End(xlUp))
    If C.Offset(, -2) <> "" And C.Offset(, -2) <> ResC Then
      ResC = C
      If Application.CountIf(C.Resize(3), "- -") = 3 Then
        Application.DisplayAlerts = False
        C.Offset(, 1).Resize(3).Copy Cells(C.Row, 15)
        C.Offset(, 1).Resize(3).Validation.Delete
        C.Offset(, 1).Resize(3).MergeCells = True
        Application.DisplayAlerts = True
        GoTo Fin
      End If
      If C.Offset(, 1).Resize(3).MergeCells = True Then
        C.Offset(, 1).Resize(3).MergeCells = False
        Cells(C.Row, 15).Resize(3).Copy C.Offset(, 1)
      End If
      For Each Cellule In C.Resize(3)
        If Cellule.Value = "- -" Then
          Cellule.EntireRow.Hidden = True
        Else
          Cellule.EntireRow.Hidden = False
        End If
      Next Cellule
    End If
Fin:
  Next C
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Tu dois supprimer tous les codes de ta feuille et notamment celui qui se trouve dans le module ThisWorkbook. De plus, je ne comprends pas ce qu'il faut faire sur la feuille Feuil1.

Daniel

 

[le___destin]

bonjour
merci Daniel pour ton aide
la fusion s'applique sur F12:F15 si ("- -")= 3
alors que je veux quel soit F12:M15
et aussi le problem et les cases reste fussionne meme si la condition change

 

[danielco]

alors que je veux quel soit F12:M15

Je suppose que tu veux dire alors que je veux quel soit F12:M15 G12:M14 ?

Private Sub Worksheet_Calculate()
Dim C As Range, ResC As String, Cellule As Range
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For Each C In Range("F12", Cells(Rows.Count, 6).End(xlUp))
    If C.Offset(, -2) <> "" And C.Offset(, -2) <> ResC Then
      ResC = C
      If Application.CountIf(C.Resize(3), "- -") = 3 Then
        Application.DisplayAlerts = False
        C.Offset(, 1).Resize(3, 7).Copy Cells(C.Row, 22)
        C.Offset(, 1).Resize(3, 7).Validation.Delete
        C.Offset(, 1).Resize(3, 7).MergeCells = True
        Application.DisplayAlerts = True
        GoTo Fin
      End If
      If C.Offset(, 1).Resize(3).MergeCells = True Then
        C.Offset(, 1).Resize(3, 7).MergeCells = False
        Cells(C.Row, 22).Resize(3, 7).Copy C.Offset(, 1)
      End If
      For Each Cellule In C.Resize(3)
        If Cellule.Value = "- -" Then
          Cellule.EntireRow.Hidden = True
        Else
          Cellule.EntireRow.Hidden = False
        End If
      Next Cellule
    End If
Fin:
  Next C
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Daniel

 

[le___destin]

bonjour Daniel
un petit probleme
le macro a la 2 eme condition vrais il recopie la premier condition " cellule merge deja " alors les donne va etre perdu

 

[danielco]

Fournis-moi un fichier entièrement non fusionné. Je ne sais plus lequel utiliser.

Daniel

 

[le___destin]

bonjours
je vous remercie beaucoup votre aide

 

[danielco]

Si je saisis 0 en A13, la plage G15:M17 est fusionnée. Si je saisis ensuite 0, on revient à l'état initial. Qu'est-ce qui ne fonctionne pas ?

Daniel

 

[le___destin]

Si tu saisi un autre zero en A14 G18:M20 fusionne
Apres si tu saisi en A13 3 il ne revient rien G15:M17 RESTE FUSIONNE ..les valeur son perdu

 

[danielco]

Pfff... Ça devient chaud ! Essaie :

Private Sub Worksheet_Calculate()
  Dim C As Range, ResC As String, Cellule As Range
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For Each C In Range("F12", Cells(Rows.Count, 6).End(xlUp))
    If C.Offset(, -2) <> "" And C.Offset(, -2) <> ResC Then
      Debug.Print C.Address(0, 0)
      ResC = C
      If Application.CountIf(C.Resize(3), "- -") = 3 Then
        If C.Offset(, 1).Resize(3).MergeCells = False Then
          Application.DisplayAlerts = False
          C.Offset(, 1).Resize(3, 7).Copy Cells(C.Row, 22)
          C.Offset(, 1).Resize(3, 7).Validation.Delete
          C.Offset(, 1).Resize(3, 7).MergeCells = True
          Application.DisplayAlerts = True
        End If
        GoTo Fin
      End If
      If C.Offset(, 1).Resize(3).MergeCells = True Then
        C.Offset(, 1).Resize(3, 7).MergeCells = False
        Cells(C.Row, 22).Resize(3, 7).Copy C.Offset(, 1)
      End If
      For Each Cellule In C.Resize(3)
        If Cellule.Value = "- -" Then
          Cellule.EntireRow.Hidden = True
        Else
          Cellule.EntireRow.Hidden = False
        End If
      Next Cellule
    End If
Fin:
  Next C
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

 

[le___destin]

merciiiiiiii beaucoup ca marche bien