Copier des lignes depuis un tableau dans un autre onglet Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
e
etienne88
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 17 février 2014
Version d'Excel : excel 2010 EN

Message par etienne88 » 17 février 2014, 00:35

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".
Si la première case de la ligne est egale à "Bob" ET la case 5 est égale à "Ingénieur" ET la valeur dans la case 7 est superieur à 200 ---> je copie la ligne dans l'onglet "Moyenne Haute".

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
http://dropcanvas.com/fnmm0 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é
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'719
Appréciations reçues : 4
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 17 février 2014, 01:03

Bonjour
:bv:

:bv3:

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
Image
e
etienne88
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 17 février 2014
Version d'Excel : excel 2010 EN

Message par etienne88 » 17 février 2014, 09:27

merci beaucoup Banzai :)

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

Bonne journée
e
etienne88
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 17 février 2014
Version d'Excel : excel 2010 EN

Message par etienne88 » 17 février 2014, 17:33

ca marche pafaitement. Merci beaucoup Banzai :)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message