Probleme dans une macro lgn = cell.Row

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)
lgn = cell.Row
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

Edit modo : Merci de mettre le code entre balises grâce au bouton </> et d'indiquer simplement la ligne présentant un problème

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

bonjour,

très probablement l'instruction find de la ligne précédente n'a pas trouvé la valeur recherchée, donc cell est vide et cell.row donne une erreur.

Pas possible pour moi de t'aider sans voir ton fichier.

Bonjour et merci de votre retour,

je vous joint le fichier.

merci de votre aide

Bonjour neim

Le problème est bien la recherche qui échoue,

Juste à changer l'ordre des lignes

Set cell = ft.Range("A:G").Find(fd.Cells(i, 3).Value, lookat:=xlWhole)
            If Not cell Is Nothing Then
              lgn = cell.Row

@+

Bonjour Bruno

Merci beaucoup

En ce qui concerne les mises en forme conditionnelles, c est possible de les effacer avec la macro ?