Copier/Coller des lignes qui respect une condition

Bonjour,

Dans le cadre d'un projet d'étude, je dois réaliser un programme sous excel avec ou sans macro. Cependant, j'ai été un peu trop ambitieux et j'ai donc besoin d'aide pour en réaliser une.

Explication :

Je dispose de 2 feuilles ("Choix d'une grue" et "Base de donnée"). J'aimerais que les lignes qui respectes un certain critère (ai comme valeur "1" dans la colonne "S" ; des lignes "4" à l'infini) soit automatiquement copier (zone de "A" à "K") et coller dans la feuille "Choix d'une Grue" dans la zone allant de "C" à "O" à partir de la ligne 16 en créant une nouvelle ligne pour chaque grue copiée.

Est-ce que cela est-il possible de le faire avec ou sans macro ?

Je vous demande de m'aider si possible, en m'expliquant la façon de faire s'il vous plait.

Merci d'avance

Cordialement,

Farekon

PS : J'ai regardé sur différent site internet, cependant, je n'arrive pas trouver des résultats intéressants.

Bonsoir,

Bonsoir,

J'ai résolu mon problème. Merci quand même.

Si jamais des personnes sont intéressés :

Sub Recherche()

Dim AG As Worksheet
Dim HO As Worksheet
Dim cell As Range
Dim MyTarget As Range
Dim MyData As Range
Dim lastRow As Long

Set AG = Worksheets("BdD Grue à Tour")
Set HO = Worksheets("Choix de la Grue")

lastRow = AG.Cells(Application.Rows.Count, 14).End(xlUp).Row
Set MyTarget = HO.Range("C16")

If Range("N10").Value < 21 Then
    For Each cell In AG.Range("U4:U" & lastRow)
    If cell.Value = "1" Then
        If MyData Is Nothing Then
            Set MyData = Range(AG.Cells(cell.Row, 1), AG.Cells(cell.Row, 12))
        Else
            Set MyData = Union(MyData, AG.Range(AG.Cells(cell.Row, 1), AG.Cells(cell.Row, 12)))
        End If
    End If
    Next

    Range("C16:N35").Select
    Selection.ClearContents

    MyData.Copy MyTarget

    Range("C16:N35").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Rows("16:35").Select
    Selection.RowHeight = 15
    Range("B13").Select
Else
    Range("C16:N35").Select
    Selection.ClearContents
End If
End Sub
Rechercher des sujets similaires à "copier coller lignes qui respect condition"