XL 2016 probleme dans une macro lgn = cell.Row

[neim]

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



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

 

[Papou-net]

Bonjour neim, le Forum,

Difficile d'être affirmatif sans fichier pour tester, mais il semblerait que la variable Cell est vide.
Tu peux t'en assurer en placent un point d'arrêt sur la ligne en jaune, puis en positionnant le curseur sur Cell tu pourras lire sa valeur.

Cordialement.

 

[neim]

Bonjour Papou-net et merci, lorsque je met le curseur sur la ligne ca me donne ca.

"variable objet ou variable de bloc With non definie"

Peut on savoir à quelle cellule la variable cell fait reference ?

 

[neim]

je vous joint le fichier

 

[neim]

Probleme resolu par Bruno en inversant les lignes (grand merci) :

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

Reste à trouver comment effacer les mises en formes conditionnelles dans la macro...si vous avez des ideees je suis preneur