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