Copier des lignes depuis un tableau dans un autre onglet

Bonjour à tous,

J'ai besoin d'un peu d'aide car je galère avec le VBA

Bon le problème est le suivant: j'ai un tableau qui a 121797 lignes (mais les valeurs commencent à la ligne numero 4)et des colonnes qui vont de A jusqu'à P. Je dois copier les lignes dans différents onglet ( Sheets) selon plusieurs conditions:

• Si la première case de la ligne est egale à "Bob" ET la case 5 est égale à "Journaliste" ET la valeur dans la case 7 est comprise entre 0 et 100 ---> je copie la ligne dans l'onglet "Moyenne Basse.
• Si la première case de la ligne est egale à "Bob" ET la case 5 est égale à "Policier" ET la valeur dans la case 7 est comprise entre 50 et 200 ---> je copie la ligne dans l'onglet "Moyenne Moyenne".

Et ce procédé doit être fait également en changeant le nom dans la case 1 et le nom dans la case 5. Le code qui suit est un exemple que j'ai écrit et dans lequel je devrais changer juste les nom mais je l'ai écrit pour tester ma macro

Sub CopyFunction()

Dim x As Long

Dim Name As String

Dim Job As Integer

With Sheets("DONNEES")

While DONNEES.Cells(i, 1).Value <> "Brigitte"    'Je ne veut pas considérer Brigitte
    For i = 4 To 121797
         Job = DONNEES.Cells(i, 5).Value
         Salary = DONNEES.Cells(i, 7).Value

    Select Case Job

     Case Is = "Policier"
       If Salaire > 0 And Salaire <= 100 Then

            x = Sheets("LOWER BOUNDARY").Range("P121797").End(xlUp).Row + 1

            DONNEES.Cells(i, 1).EntireRow.Copy Sheets("LOWER BOUNDARY").Rows(x)

       ElseIf Salaire> 50 And Salaire <=200 Then

            x = Sheets("MIDDLE BOUNDARY").Range("P121797").End(xlUp).Row + 1

           DONNEES.Cells(i, 1).Cells.EntireRow.Copy Sheets("MIDDLE BOUNDARY").Rows(x)

       ElseIf Salaire > 200 Then

            x = Sheets("HIGHER BOUNDARY").Range("P121797").End(xlUp).Row + 1

            DONNEES.Cells(i, 1).EntireRow.Copy Sheets("HIGHER BOUNDARY").Rows(x)

       End If

     Case Is = "Pompier"
     If Salaire> 0 And Salaire <= 50 Then

            x = Sheets("LOWER BOUNDARY").Range("P121797").End(xlUp).Row + 1

            DONNEES.Cells(i, 1).Cells.EntireRow.Copy Sheets("LOWER BOUNDARY").Rows(x)

       ElseIf Salaire > 50 And Salaire <= 200 Then

            x = Sheets("MIDDLE BOUNDARY").Range("P121797").End(xlUp).Row + 1

           DONNEES.Cells(i, 1).EntireRow.Copy Sheets("MIDDLE BOUNDARY").Rows(x)

       ElseIf Salaire > 200 Then

            x = Sheets("HIGHER BOUNDARY").Range("P121797").End(xlUp).Row + 1

           DONNEES.Cells(i, 1).EntireRow.Copy Sheets("HIGHER BOUNDARY").Rows(x)

       End If

    End Select
    Next
   End

Wend

End With

End Sub

Le fichier test est ici (c'est un exemple)

Je ne comprend pas où est l'erreur

Merci beaucoup pour l'aide car je suis vraiment paumé

Bonjour

Si tu peux fournir un vrai fichier Excel (tu sais ceux qui on comme extension .xlsm)

En attendant à tester

Sub CopyFunction()
Dim x As Long, I As Long
Dim Name As String
Dim Job As Integer

  With Sheets("DONNEES")
    For I = 4 To 121797
      If .Cells(I, 1).Value <> "Brigitte" Then    ' 'Je ne veux pas considérer Brigitte
        Job = .Cells(I, 5).Value
        Salary = .Cells(I, 7).Value
        Select Case Job
          Case Is = "Policier"
            If Salaire > 0 And Salaire <= 100 Then
              x = Sheets("LOWER BOUNDARY").Range("P121797").End(xlUp).Row + 1
              .Rows(I).Copy Sheets("LOWER BOUNDARY").Rows(x)
            ElseIf Salaire > 50 And Salaire <= 200 Then
              x = Sheets("MIDDLE BOUNDARY").Range("P121797").End(xlUp).Row + 1
              .Rows(I).Copy Sheets("MIDDLE BOUNDARY").Rows(x)
            ElseIf Salaire > 200 Then
              x = Sheets("HIGHER BOUNDARY").Range("P121797").End(xlUp).Row + 1
              .Rows(I).Copy Sheets("HIGHER BOUNDARY").Rows(x)
            End If
          Case Is = "Pompier"
            If Salaire > 0 And Salaire <= 50 Then
              x = Sheets("LOWER BOUNDARY").Range("P121797").End(xlUp).Row + 1
              .Rows(I).Copy Sheets("LOWER BOUNDARY").Rows(x)
            ElseIf Salaire > 50 And Salaire <= 200 Then
              x = Sheets("MIDDLE BOUNDARY").Range("P121797").End(xlUp).Row + 1
             .Rows(I).Copy Sheets("MIDDLE BOUNDARY").Rows(x)
            ElseIf Salaire > 200 Then
              x = Sheets("HIGHER BOUNDARY").Range("P121797").End(xlUp).Row + 1
             .Rows(I).Copy Sheets("HIGHER BOUNDARY").Rows(x)
            End If
        End Select
      End If
    Next I
  End With
End Sub

merci beaucoup Banzai

Je vais tester cela sur un fichier .xlsm et je vais également le mettre ici

Bonne journée

ca marche pafaitement. Merci beaucoup Banzai