1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
| Sub MacroCopieCellIfNOk()
Dim x As Variant
Dim LastRow As Long
Dim WsDepart As Worksheet
Dim WsDestination As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WsDestination = SHEETS("Lup")
Set WsDepart = SHEETS("Developpement")
' Cela suppose que la colonne S soit remplie
' avec qqs données sinon à adapter à ton contexte
LastRow = WsDestination.Range("A" & Rows.Count).End(xlUp).Row
Application.Calculation = xlManual
For Each x In Range("S8", Range("U65000").End(xlUp).Offset(0, -1))
'Si valcell = NOK copier les Celulles concernées depuis la feuille (Developpement) et coller dans la feuille (LUP)
If x = "NOK" Then
With WsDepart
Range("E6:H6").UnMerge
End With
With WsDestination
End With
With WsDepart
WsDepart.Range("E6").Copy
WsDestination.Range("B" & LastRow + 1).PasteSpecial xlPasteValues
End With
WsDepart.Range("C18").Copy
WsDestination.Range("G" & LastRow + 1).PasteSpecial xlPasteValues
With WsDepart
Range("E6:H6").Merge
End With
WsDepart.Range("AA4").Copy
WsDestination.Range("C" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("V5").Copy
WsDestination.Range("D" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("AA1").Copy
WsDestination.Range("E" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("Y5").Copy
WsDestination.Range("F" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("F1").Copy
WsDestination.Range("G" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("Y6").Copy
WsDestination.Range("H" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("Y5").Copy
WsDestination.Range("I" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("B8").Copy
WsDestination.Range("J" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("V8").Copy
WsDestination.Range("K" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("B8").Copy
WsDestination.Range("J" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("AF3").Copy
WsDestination.Range("L" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("AF3").Copy
WsDestination.Range("M" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("AF3").Copy
WsDestination.Range("N" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("AF3").Copy
WsDestination.Range("O" & LastRow + 1).PasteSpecial xlPasteValues
'WsDepart.Range("C15:C22").ClearContents
Set WsDestination = Nothing
Set WsDepart = Nothing
End If
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
'attention a spécifié la variable de la fonction next
Next x
Application.ScreenUpdating = True
End Sub |
Partager