Accélérer une macro intégrant plusieurs feuille

bonsoir

j'ai besoin d'accélérer une macro que j'ai bricolé (je débute en vba, pardon pour les puristes on peut sûrement mieux faire.)

dans le fichier joint

je cherche à copier des données de la feuille "CO B" et "CO C" vers la feuille "remplacement" sous condition que la colonne E contienne l'indication "à prévoir " "à suivre" "géré".Dans ce cas copier toute la ligne.j'ai donc répété dans la macro l'action sur chaque feuille :il y a surement plus simple

dans la feuille remplacement

j'aimerais que l'affichage des résultats soit par grade " I" d'abord et "A" ensuite.Dans chaque grade à prévoir d'abord ensuite à suivre et pour finir géré grade I d'abord ceux voir visuel attendu sous onglet remplacement.

merci de l'aide que vous pourrez m'apporter , et ainsi me faire progresser , je n'apprend le VBA que depuis 3 semaines .

23test-effectifs.zip (74.37 Ko)

Bonjour Ohua1

Pour ce qui est de la rapidité, voici le code optimisé

Sub CopierLigne()
  Dim Lig As Long, Col As String
  Dim NbrLig As Long, NumLig As Long
  ' Feuille de destination
  Sheets("Remplacement").Activate
  ' Colonne des données à tester
  Col = "E"
  ' le n° de la 1ère ligne de données de destination
  NumLig = 8
  With Sheets("CO B")    'feuille source
    NbrLig = .Cells(65536, Col).End(xlUp).Row
    For Lig = 9 To NbrLig Step 2
      If .Cells(Lig, Col).Value = "géré" Or .Cells(Lig, Col).Value = "à suivre" Or .Cells(Lig, Col).Value = "à clarifier" Or .Cells(Lig, Col).Value = "à prévoir" Then
        .Rows(Lig & ":" & Lig + 1).EntireRow.Copy Destination:=Sheets("Remplacement").Cells(NumLig, 1)
        NumLig = NumLig + 2
      End If
    Next
  End With
  With Sheets("CO C")    'feuille source
    NbrLig = .Cells(65536, Col).End(xlUp).Row
    For Lig = 9 To NbrLig Step 2
      If .Cells(Lig, Col).Value = "géré" Or .Cells(Lig, Col).Value = "à suivre" Or .Cells(Lig, Col).Value = "à clarifier" Or .Cells(Lig, Col).Value = "à prévoir" Then
        .Rows(Lig & ":" & Lig + 1).EntireRow.Copy Destination:=Sheets("Remplacement").Cells(NumLig, 1)
        NumLig = NumLig + 2
      End If
    Next
  End With
End Sub

Pour le tri, c'est à voir

A+

merci beaucoup bruno

je teste cela

je cherche pour le tri aussi de mon côté

encore merci pour cette aide

Rechercher des sujets similaires à "accelerer macro integrant feuille"