XL 2019 suppression de valeur + copie

JeremyLeMalouin

XLDnaute Nouveau
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
 

Pièces jointes

  • 253.xlsm
    16.1 KB · Affichages: 3

Staple1600

XLDnaute Barbatruc
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 ?)
VB:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Re

Donc un petit exemple
VB:
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

XLDnaute Barbatruc
Re

Un exemple plus simple et qui colle plus à la question ;)
VB:
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
 

Discussions similaires

Réponses
17
Affichages
760
Réponses
12
Affichages
537