Reporter cellules cous condition

Bonjour à tous,

Dans ce tableau (simplifié pour ici), j'essaye de créer une macro qui reporte en Période 2 les tâches non exécutées en Période 1, autrement dit :

copier toutes les cellules non vides de la plage 'Période 1'A2:A30 sur la plage 'Période 2'A2:A30, si la cellule correspondante de la colonne B est vide.
Dans le tableau joint j'ai enregistré une macro qui fait ça, mais bien sûr elle ne marche que pour ce cas-là ; je n'arrive pas à écrire la condition.
J'ai quand même cherché et fait une pauvre tentative (ne riez pas) :

Sub Macro1()
'
' Macro1 Macro
'If Sheets("Saison 1").Range("A2:A30").Text <> "" And Sheets("Saison1").Range("B2:B30").Text = "" Then
Sheets("Saison 1").Range("A2:A30").Copy
Sheets("Saison 2").Range("A2").Paste
End If

End Sub<br>

Évidemment, ça marche pas, même la syntaxe est pas bonne, je n'arrive pas à aller plus loin que l'erreur "End if sans bloc if".

Quelqu'un pourrait m'aiguiller s'il vous plaît ?

Merci beaucoup.

Nico

Bonjour nikopo, le forum,

Un essai...

Option Explicit

Dim tablo, tabloR()
Dim i&, k&

Sub Report()
    tablo = Sheets("Période 1").Range("A1").CurrentRegion
        k = 0
    For i = 2 To UBound(tablo, 1)
        If tablo(i, 2) = "" Then
            ReDim Preserve tabloR(1 To 1, 1 To k + 1)
             tabloR(1, 1 + k) = tablo(i, 1)
        k = 1 + k
        End If
    Next i

    With Sheets("Période 2")
     .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
      On Error Resume Next
     .Range("A2").Resize(UBound(tabloR, 2), 1) = Application.Transpose(tabloR)
     .Activate
   End With
End Sub

Cordialement,

Re,

Autre possibilité en filtrant en fonction de la colonne B...

Sub Report()
 Dim dl1 As Long, dl2 As Long

  Application.ScreenUpdating = False

   With Sheets("Période 2")
    .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    dl2 = .Range("A" & Rows.Count).End(xlUp).Row + 1
   End With

   With Sheets("Période 1")
    dl1 = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:B" & dl1).AutoFilter field:=2, Criteria1:=""
    .Range("A2:B" & dl1).SpecialCells(xlVisible).Copy Sheets("Période 2").Range("A" & dl2)
     If .FilterMode = True Then .ShowAllData
   End With
   Sheets("Période 2").Activate
  Application.ScreenUpdating = True
End Sub

Cordialement,

Bonjour,

C'est super, merci beaucoup. Mais, ouille, c'est compliqué . Je vais tester tout ça mais mais ça va être coton : mon tableau d'origine est en fait bien différent et plus complexe, et il va falloir que je transpose. De plus, je dois répéter cette macro pour 11 plages différentes. A suivre.

Bonsoir,

La solution 1 marche avec le tableau que j'ai donné, mais ça ne colle pas car la fonction CurrentRegion, affecte toutes les cellules dessous. Or dans mon tableau d'origine, il y a d'autres cellules en dessous, que la macro ne doit pas prendre en compte. Le fichier que j'ai mis était trop simplifié, désolé, vous ne pouviez pas deviner. Je remets un tableau qui reproduit les conditions exactes, avec les deux macros (mal) transposées :

Comme vous le verrez j'ai donc essayé de transposer votre première macro, mais sans succès. Il affiche l'erreur "l'indice n'appartient pas à la sélection", qui doit venir normalement d'un emplacement introuvable....mais lequel ? Le débogueur cible la ligne If tablo(i, 3) = "" Then

Pour la deuxième macro, j'ai réussi à la faire marcher mais elle aussi sélectionne des cellules en dehors de la plage voulue, et les copie trop bas dans le tableau cible.

Pouvez-vous me dire où ça coince ?

Merci beaucoup.

Bonjour nikopo, le forum,

Si ta plage est fixe, il te suffit de la modifier comme ceci:

Option Explicit

Dim tablo, tabloR()
Dim i&, k&, dl%

Sub Report()

    tablo = Sheets("Saison 1").Range("B9:D53")
        k = 0
    For i = 1 To UBound(tablo, 1)
        If tablo(i, 3) = "" Then
            ReDim Preserve tabloR(1 To 1, 1 To k + 1)
             tabloR(1, 1 + k) = tablo(i, 1)
        k = 1 + k
        End If
    Next i

    With Sheets("Saison 2")
     .Range("B9:D53").ClearContents
      On Error Resume Next
     .Range("B9").Resize(UBound(tabloR, 2), 1) = Application.Transpose(tabloR)
     .Activate
   End With
End Sub

où

Sub Report2()
 Dim dl1 As Long

  Application.ScreenUpdating = False

   With Sheets("Saison 2")
    .Range("B9:D53").ClearContents
   End With

   With Sheets("Saison 1")
    dl1 = .Range("B" & Rows.Count).End(xlUp).Row
    .Range("B8:D53").AutoFilter field:=3, Criteria1:=""
    .Range("B9:B53").SpecialCells(xlVisible).Copy Sheets("Saison 2").Range("B9")
     If .FilterMode = True Then .ShowAllData
   End With
   Sheets("Saison 2").Activate
  Application.ScreenUpdating = True
End Sub

Cordialement,

Bonjour xorsankukai,

Formidable. J'ai transposé ça pour mes 11 plages de cellules. J'y ai ajouté un code glané sur ce forum pour pouvoir effectuer la macro sur les feuilles protégées, ainsi qu'une msgbox de confirmation (toujours glané sur le forum). Au final, ça fait un code assez long, mais ça marche très bien.

J'ai testé les deux solutions ; les deux marchent mais j'ai utilisé la première. Déjà parce que je la comprends un peu plus (je suis quasi néophyte), et de plus la deuxième solution est basée sur les filtres et après la macro, les flèches de filtre restent affichées dans les cellules.

En tout cas, merci mille fois, grâce à vous (et aux autres articles du forum) mon tableau est fin prêt.

A une prochaine.

nikopo