XL 2019 suppression de valeur + copie

[JeremyLeMalouin]

bonjour je suis en train de concevoir un tableur pouvant faire des calculs mécaniques en composite, mais avant sa j'aimerais pouvoir en fonction du nombre de plis sélectionner la fibre à utiliser cette partie a été réussi grâce à d'autres discussions sur ce forum. maintenant j'aimerais pouvoir rajouter une âme dans des plis particuliers.

exemple: j'ai 15 plis, je veux mettre une âme aux plis 8, donc je dois remplacer le fibre aux plis 8 par une âme

première partit du code:

Sub automatique()
Dim j As Integer, i As Integer

[E2:E200].ClearContents
[F2:F200].ClearContents
For j = 1 To Range("B65000").End(xlUp)
For i = 2 To Cells(j, 2).Value
Cells(j, 3).Copy Destination:=Range("E" & Range("E65000").End(xlUp).Row + 1)
Cells(j, 4).Copy Destination:=Range("F" & Range("F65000").End(xlUp).Row + 1)
Next i
Next j
End Sub

 

[Staple1600]

Bonsoir le fil, Jeremy

Jeremy
De Rennais à Malouin, je me permets une suggestion en passant 😉
En théorie, ta macro ainsi modifiée doit faire la même chose (mais un peu plus rapidement, non ?)

Sub automatique_B()
Dim j&, i&
Application.ScreenUpdating = False
[E2:F200] = ""
  For j = 1 To Cells(Rows.Count, 2).End(xlUp).Row
      For i = 2 To Cells(j, 2).Value
      Cells(j, 3).Resize(, 2).Copy Cells(Rows.Count, "E").End(3)(2)
      Application.CutCopyMode = False
      Next i
  Next j
End Sub

 

[JeremyLeMalouin]

bonsoir, Starple
merci d'avoir pris le temps d'améliorer ma macro. en effet celle-ci s’exécute plus rapidement.
Par hasard ne serait tu pas comment lire une valeur dans une cellule et que cette même valeur soit utilisée en tant que coordonner de ligne pour supprimer une case (la colonne est déjà connue)?

et vive la Bretagne

 

[Staple1600]

RE

Jemery
Moi c'est Staple, pas Starple 😉

Et la réponse à la question est oui

(et vive les Bretons 😉)

 

[Staple1600]

Re

Donc un petit exemple

Sub Petit_Exemple()
Dim Ligne&, Rng, Q
Randomize
Ligne = Application.RandBetween(1, Asc("Staple") + 1517) 'pour le fun ;-)
Set Rng = Cells(Ligne, "S")
Q = MsgBox("Supprimer la ligne : " & Rng.Row, vbYesNo, "Suppression ligne")
If Q = vbYes Then
Rng.EntireRow.Delete
Else
Exit Sub
End If
End Sub

 

[Staple1600]

Re

Un exemple plus simple et qui colle plus à la question 😉

Sub ExempleII()
Dim Rng As Range
Set Rng = [S1600]
Rng = 15
MsgBox "Valeur dans cellule S1600: " & Rng, vbInformation
MsgBox Cells(Rng.Value, "C").Address(0, 0), vbInformation, "Adresse cellule selon valeur S1600"
Cells(Rng.Value, "C").Interior.Color = vbYellow
MsgBox "Supprimer ligne?"
Cells(Rng.Value, "C").EntireRow.Delete
End Sub