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