Demande de correction de macro Résolu/Fermé

Question

Bonjour je n'arrive pas a optimiser la macro (ice)dans le module 1 le but et de transposer dans la plage (M3:T10) les deux plages (W3:AD10,C3:J10) en récupérant uniquement les cellules non vide et d'imbriquer la macro ice dans la macro qui se trouve dans la feuil 1 j' ai fais un essai avec Range("M3:T10").Value = Application.Union(Range("W3:AD10"), Range("C3:J10")).Value mais j' ai toujours le meme problème il n y a qu'une des deux plages qui arrive dans ("M3:T10") voici la macro problématique Sub ice() Range("M3:T10").Value = Range("W3:AD10,C3:J10").Value If Range("W3:AD10,C3:J10") <> "" Then Range("A1").Select End If End Sub et voici la macro dans la quel je souhaite imbriquer la macro ice Private Sub Worksheet_Change(ByVal Target As Range) Dim isect As Range, c As Range Set isect = Intersect(Target, [AC3:AD4,AC6:AD7,AC9:AD10]) If Not isect Is Nothing Then For Each c In Target.Cells If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(7, 30, 0), Empty) End If Next c End If Set isect = Intersect(Target, [Z3:AA4,Z6:AA7,Z9:AA10]) If Not isect Is Nothing Then For Each c In Target.Cells If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(3, 45, 0), Empty) End If Next c End If Set isect = Intersect(Target, [W3:X4,W6:X7,W9:X10]) If Not isect Is Nothing Then For Each c In Target.Cells If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(15, 0, 0), Empty) End If Next c End If ice End Sub Merci d'avance

Patrice33740 · Answer

Bonjour,

« le but et de transposer dans la plage (M3:T10) les deux plages (W3:AD10,C3:J10)
en récupérant uniquement les cellules non vide .... »
Il faut tester le contenu de chaque cellule correspondante des 2 plages, mais que fais-tu lorsque les 2 cellules contiennent une valeur ?
Option Explicit
Sub ice()
Dim r1 As Range
Dim r2 As Range
Dim rd As Range
Dim L As Long
Dim C As Long
  Set r1 = Range("C3:J10")
  Set r2 = Range("W3:AD10")
  Set rd = Range("M3:T10")
  For L = 1 To r1.Rows.Count
    For C = 1 To r1.Columns.Count
      If r1(C, L).Formula = "" Then
        rd(C, L).Value = r2(C, L).Value
      ElseIf r2(C, L).Formula = "" Then
        rd(C, L).Value = r1(C, L).Value
      Else
        rd(C, L).Formula = "Pas prévu"
      End If
    Next C
  Next L
End Sub

Demande de correction de macro

1 réponse

Discussions similaires