Comment copier des lignes issues de plusieurs feuilles de calcul vers une nouvelle feuille en fonction de critères spécifiques ?

Supposons que vous disposiez d’un classeur contenant trois feuilles de calcul ayant le même format que celui illustré dans la capture d’écran ci-dessous. Vous souhaitez maintenant copier toutes les lignes de ces feuilles pour lesquelles la colonne C contient le texte « Completed » vers une Nouvelle feuille de calcul. Comment résoudre ce problème rapidement et facilement sans devoir effectuer manuellement les opérations de copier-coller une par une ?

Copier des lignes depuis plusieurs feuilles de calcul selon des critères vers une nouvelle feuille à l’aide d’un code VBA

---

Copier des lignes depuis plusieurs feuilles de calcul selon des critères vers une nouvelle feuille à l’aide d’un code VBA

Le code VBA suivant vous permet de copier, vers une nouvelle feuille de calcul, les lignes correspondant à une condition donnée depuis toutes les feuilles du classeur. Procédez comme suit :

1. Maintenez enfoncées les touches ALT + F11 pour ouvrir la fenêtre Microsoft Visual Basic pour Applications.

2. Cliquez sur Insertion > Module, puis collez le code suivant dans la fenêtre du module.

Code VBA : Copier des lignes depuis plusieurs feuilles selon des critères vers une nouvelle feuille

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

Remarque: Dans le code ci-dessus :

• Le texte «Completed» dans ce xRStr = «Completed»script indique la condition spécifique selon laquelle vous souhaitez copier les lignes ;
• C:C dans ce Set xRg = xWs.Range(«C:C») script indique la colonne où se situe la condition.

3. Ensuite, appuyez sur la touche F5 pour exécuter ce code. Toutes les lignes répondant à la condition spécifiée sont automatiquement copiées et collées dans une nouvelle feuille de calcul nommée « Kutools pour Excel » au sein du classeur actuel. Voir la capture d’écran :

---

---

Plus d’articles connexes sur l’extraction ou la copie de données :