Macro ne voulant pas fonctionner ds pls cas

Bonjour, voici la macro que j'ai réalisé, elle consiste à créer une nouvelle feuille et y coller les des lignes d'une autre feuille comprise ds le meme classeur en fonction de valeur préalablement fixer par la macro pour désigner les lignes de cette première feuille.

en gros, dans le premier tableau g des lignes affecter des valeurs
BR
DO
AS
AC
....

ma macro fonctionne correctement pour les deux premiers cas mais ensuite elle ne fonctionne plus, elle me créé la feuille mais ne copie plus les lignes dans cette nouvelles feuille.

Voici la macro

Sub commandeBRENT()
Dim DerLig As Integer
Dim ligne As Integer

'calcul de la dernière ligne de la feuille EnCours
With Sheets(Sheets.Count)
DerLig = .Range("C" & .Rows.Count).End(xlUp).Row

End With

ligne = 23

'on identifie chaque entreprise par ces deux première lettres en colonne E'
Do Until ligne > DerLig
Range(Cells(ligne, "E"), Cells(ligne, "E")).Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-4],2)"

ligne = ligne + 1
Loop

'Création de la feuille BR'
ligne = 23

Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Sheets(Sheets.Count).Name = "BR"

Columns("A:A").ColumnWidth = 64
Columns("B:B").ColumnWidth = 50
Columns("C:C").ColumnWidth = 9.57
Columns("D:D").ColumnWidth = 4.14

Rows("20:20").Select

ActiveWindow.FreezePanes = True

Sheets(Sheets.Count - 2).Select
Range("A1:B4").Select
Selection.Copy
Sheets("BR").Select
Range("A1").Select
ActiveSheet.Paste
Sheets(Sheets.Count - 2).Select
Range("A22:D22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BR").Select
Range("A19").Select
ActiveSheet.Paste
Range("A16").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "COMMANDE BRENT"
Range("A17").Select


'copier les lignes BRENT'
Sheets(Sheets.Count - 2).Select

Do Until ligne > DerLig
If Range(Cells(ligne, "E"), Cells(ligne, "E")).Value = "BR" Then

Range(Cells(ligne, "A"), Cells(ligne, "D")).Select
Selection.Copy
Sheets("BR").Select
Range(Cells(ligne, "A"), Cells(ligne, "A")).Select
ActiveSheet.Paste
Sheets(Sheets.Count - 2).Select
ligne = ligne + 1
Else
ligne = ligne + 1
End If

Loop

MsgBox "La commande Brent a été réalisée avec succès "

End Sub

si une personne a une idée d'ou peut provenir mon pb, ou qui souhaite plus d'informations vous êtes les bienvenus !!!