Répondre à la discussion

Message

<blockquote data-quote="neim" data-source="post: 20353259" data-attributes="member: 231155">Bonjour à tous,La macro ci dessous sert à copier des lignes d'une feuille pour la coller dans une autre. Ca fonctionne très bien sauf que quand je veux faire un tri sur la premiere feuille, ca ne fonctionne plus et la ligne en jaune apparait dans le debogage :Set fd = Sheets(&quot;données&quot;)Set fc = Sheets(&quot;Liste clients&quot;)Set ft = Sheets(&quot;Test&quot;)Set dico = CreateObject(&quot;Scripting.Dictionary&quot;)Application.ScreenUpdating = FalseFor i = 2 To fc.Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Rowdico(fc.Range(&quot;A&quot; &amp; i).Value) = &quot;&quot;Next i'initialisationderLn = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).RowFor i = derLn To 2 Step -1If Not (dico.exists(Range(&quot;A&quot; &amp; i).Value) And Range(&quot;B&quot; &amp; i) = &quot;&quot;) ThenRange(&quot;A&quot; &amp; i &amp; &quot;:R&quot; &amp; i).Delete Shift:=xlUpEnd IfNext iderLn = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).RowFor i = derLn To 2 Step -1Range(&quot;A1:G1&quot;).CopyRange(&quot;A&quot; &amp; i &amp; &quot;:G&quot; &amp; i).Insert Shift:=xlDownNext iRange(&quot;A1:G1&quot;).Delete Shift:=xlUp'ReportFor i = 3 To fd.Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).RowIf fd.Range(&quot;C&quot; &amp; i) &lt;&gt; &quot;&quot; ThenSet cell = ft.Range(&quot;A:G&quot;).Find(fd.Cells(i, 3).Value, lookat:=xlWhole)lgn = cell.RowIf Not cell Is Nothing Then'If cell.Offset(2, 0) = &quot;&quot; ThenIf Cells(lgn + 2, 2) = &quot;&quot; Thencell.Offset(1, 0).Resize(1, 18).Insert Shift:=xlDownfd.Range(&quot;A1:R1&quot;).Copycell.Offset(2, 0).Resize(1, 18).Insert Shift:=xlDownCells(lgn + 1, 1).Offset(1, 2).Delete Shift:=xlToLeftEnd Ifd = 0Do Until Cells(lgn + 2 + d, 1) = &quot;&quot;d = d + 1Loopln = lgn + 2 + dRange(&quot;A&quot; &amp; ln &amp; &quot;:Q&quot; &amp; ln).Insert Shift:=xlDownfd.Range(&quot;A&quot; &amp; i &amp; &quot;:B&quot; &amp; i).Copy Range(&quot;A&quot; &amp; ln)fd.Range(&quot;D&quot; &amp; i &amp; &quot;:R&quot; &amp; i).Copy Range(&quot;C&quot; &amp; ln)End IfEnd IfNext iEnd SubJ'ai essayé d'ajouter cet enregistrement de macro automatique mais le probleme reste le même.Option ExplicitDim fd As Worksheet, fc As Worksheet, ft As Worksheet, cell As RangeDim dico As ObjectDim i&amp;, derLn&amp;, lgn&amp;, ln&amp;, d&amp;Sub Planning()Columns(&quot;A:Q&quot;).SelectActiveWorkbook.Worksheets(&quot;données&quot;).Sort.SortFields.ClearActiveWorkbook.Worksheets(&quot;données&quot;).Sort.SortFields.Add2 Key:=Range( _&quot;C2:C280&quot;), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _xlSortNormalActiveWorkbook.Worksheets(&quot;données&quot;).Sort.SortFields.Add2 Key:=Range( _&quot;G2:G280&quot;), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _xlSortNormalActiveWorkbook.Worksheets(&quot;données&quot;).Sort.SortFields.Add2 Key:=Range( _&quot;F2:F280&quot;), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _xlSortNormalWith ActiveWorkbook.Worksheets(&quot;données&quot;).Sort.SetRange Range(&quot;A1:Q280&quot;).Header = xlYes.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlPinYin.ApplyEnd WithRange(&quot;A2&quot;).SelectAuriez vous une solution à ce problème ?J aurais aimé aussi qu'au lancement de la macro, les mises en forme conditionnelle soit effacée avant de recopier les lignes. Est ce possible ,Merci de votre aideCordialement</blockquote>

[QUOTE="neim, post: 20353259, member: 231155"] Bonjour à tous, La macro ci dessous sert à copier des lignes d'une feuille pour la coller dans une autre. Ca fonctionne très bien sauf que quand je veux faire un tri sur la premiere feuille, ca ne fonctionne plus et la ligne en jaune apparait dans le debogage : Set fd = Sheets("données") Set fc = Sheets("Liste clients") Set ft = Sheets("Test") Set dico = CreateObject("Scripting.Dictionary") Application.ScreenUpdating = False For i = 2 To fc.Range("A" & Rows.Count).End(xlUp).Row dico(fc.Range("A" & i).Value) = "" Next i 'initialisation derLn = Range("A" & Rows.Count).End(xlUp).Row For i = derLn To 2 Step -1 If Not (dico.exists(Range("A" & i).Value) And Range("B" & i) = "") Then Range("A" & i & ":R" & i).Delete Shift:=xlUp End If Next i derLn = Range("A" & Rows.Count).End(xlUp).Row For i = derLn To 2 Step -1 Range("A1:G1").Copy Range("A" & i & ":G" & i).Insert Shift:=xlDown Next i Range("A1:G1").Delete Shift:=xlUp 'Report For i = 3 To fd.Range("A" & Rows.Count).End(xlUp).Row If fd.Range("C" & i) <> "" Then Set cell = ft.Range("A:G").Find(fd.Cells(i, 3).Value, lookat:=xlWhole) [B]lgn = cell.Row[/B] If Not cell Is Nothing Then 'If cell.Offset(2, 0) = "" Then If Cells(lgn + 2, 2) = "" Then cell.Offset(1, 0).Resize(1, 18).Insert Shift:=xlDown fd.Range("A1:R1").Copy cell.Offset(2, 0).Resize(1, 18).Insert Shift:=xlDown Cells(lgn + 1, 1).Offset(1, 2).Delete Shift:=xlToLeft End If d = 0 Do Until Cells(lgn + 2 + d, 1) = "" d = d + 1 Loop ln = lgn + 2 + d Range("A" & ln & ":Q" & ln).Insert Shift:=xlDown fd.Range("A" & i & ":B" & i).Copy Range("A" & ln) fd.Range("D" & i & ":R" & i).Copy Range("C" & ln) End If End If Next i End Sub J'ai essayé d'ajouter cet enregistrement de macro automatique mais le probleme reste le même. Option Explicit Dim fd As Worksheet, fc As Worksheet, ft As Worksheet, cell As Range Dim dico As Object Dim i&, derLn&, lgn&, ln&, d& Sub Planning() Columns("A:Q").Select ActiveWorkbook.Worksheets("données").Sort.SortFields.Clear ActiveWorkbook.Worksheets("données").Sort.SortFields.Add2 Key:=Range( _ "C2:C280"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("données").Sort.SortFields.Add2 Key:=Range( _ "G2:G280"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("données").Sort.SortFields.Add2 Key:=Range( _ "F2:F280"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("données").Sort .SetRange Range("A1:Q280") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A2").Select Auriez vous une solution à ce problème ? J aurais aimé aussi qu'au lancement de la macro, les mises en forme conditionnelle soit effacée avant de recopier les lignes. Est ce possible , Merci de votre aide Cordialement [/QUOTE]

Vérification