Problème boucle sur plusieurs feuilles

Bonjour,

j'ai un problème dans ma macro j'aimerai répuerer tous les lignes de chaque feuille et non juste la première ligne.

Ci-dessous la macro:


Sub Assembler() 'Nom de la macro
'Eviter l'ajout des mêmes lignes erase feuille avant lancement
With Worksheets("Portefeuille Projet")
.Rows("3:65536").EntireRow.Delete
End With

'Date de dernière mise à jour

Range("D1").Value = Format(Now, "mm/dd/yyyy HH:MM") 'Date de mise à jour des données

Dim i As Long, j As Long 'Déclare deux variables numériques
Worksheets("Portefeuille Projet").Select 'Active la feuille nommée Portefeuille Projet
'Passe chaque feuille en revue en partant de la 3eme jusqu'à x

For i = 5 To Worksheets.Count - 2 'WorkSheets.Count donne le nombre total de feuilles
'j prend la valeur du numéro de ligne de la 1ere cellule vide de la colonne A
'A chaque passage dans la boucle j sera incrémentée de 1 du fait de l inscription des nouvelles données

j = Range("A65536").End(xlUp).Row + 1

With Worksheets(i)

'Sur la ligne déterminée par j, la 1ere cellule prend la valeur de la cellule A1 de la feuille dont l'index est égal à i
'Code activité
If .Range("F3").Value > "" Then
Cells(j, 1).Value = .Range("F3").Value
Else
Cells(j, 1).Value = "X"
End If
'Code projet
If .Range("E3").Value > "" Then
Cells(j, 2).Value = .Range("E3").Value
Else
Cells(j, 2).Value = "X"
End If
'Projet
If .Range("H3").Value > "" Then
Cells(j, 3).Value = .Range("H3").Value
Else
Cells(j, 3).Value = "X"
End If
'Chantier/Lot
If .Range("I3").Value > "" Then
Cells(j, 4).Value = .Range("I3").Value
Else
Cells(j, 4).Value = "X"
End If
'Mois référence
If .Range("C3").Value > "" Then
Cells(j, 6).Value = .Range("C3").Value
Else
Cells(j, 6).Value = "X"
End If
'Nombre UO Interne
If (.Range("AA3").Value + .Range("AB3").Value) > "0" Then
Cells(j, 7).Value = .Range("AA3").Value + .Range("AB3").Value
Else
Cells(j, 7).Value = "0"
End If
'Nombre UO Total
If .Range("AG3").Value > "0" Then
Cells(j, 8).Value = .Range("AG3").Value
Else
Cells(j, 8).Value = "0"
End If
'Montant
If (.Range("AH3").Value + .Range("AH3").Value) > "0" Then
Cells(j, 9).Value = .Range("AH3").Value + .Range("AH3").Value
Else
Cells(j, 9).Value = "0"
End If
'Responsable CP IDS
If (.Range("U3").Value) > "0" Then
Cells(j, 10).Value = .Range("U3").Value
Else
Cells(j, 10).Value = "0"
End If
'Année référence
If (.Range("C3").Value) > "0" Then
Cells(j, 11).Value = .Range("C3").Value
Else
Cells(j, 11).Value = "0"
End If
'Type
Cells(j, 12).Value = "D"
'N°devis
Cells(j, 13).Value = .Range("D3").Value
'Devis validé (O/N/R)
If .Range("AI3").Value > "" Then
Cells(j, 15).Value = "V"
Else
Cells(j, 15).Value = "N"
End If
'Domaine
Cells(j, 17).Value = "E00028/02/08/02"
'RAF
Cells(j, 18).Value = .Range("AL3").Value + .Range("AN3").Value + .Range("AP3").Value + .Range("AR3").Value + .Range("AT3").Value
End With
Next 'Passe à la feuille suivante

'******************** POST-TRAITEMENT ********************

'******Convertir les dates de la colonne F en mois******

Dim DerLig As Long
Dim Cel As Range
With Worksheets("Portefeuille Projet") 'Nom de feuille à adapter
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Convertir les dates de la colonne F
For Each Cel In .Range("F3:F" & DerLig)
Cel.NumberFormat = "mm"
Next
End With

'******Convertir les dates de la colonne K en année******

Dim DerLig1 As Long
Dim Cel1 As Range
With Worksheets("Portefeuille Projet") 'Nom de feuille à adapter
DerLig1 = .Range("A" & .Rows.Count).End(xlUp).Row
'Convertir les dates de la colonne K
For Each Cel1 In .Range("K3:k" & DerLig1)
Cel1.NumberFormat = "yyyy"
Next
End With


End Sub 'Fin

MErci d'avance