Macro à répéter plusieurs fois
Bonjour,
J'en suis à la création de ma première macro:
j'ai un fichier master avec différentes infos dont un différentiel dans la colonne v.
Je veux exécuter une macro, qui si le résultat du différentiel dans la colonne V (V4 de mon fichier) du fichier Master est inférieur à O, va copier le contenu de l'onglet "Individual Summary" dans un nouvel onglet "New summary" et inscrire la cellule A4 (Id number) du fichier "Master" dans la cellule C3 du nouveau fichier New Summary (PerNer).
Je veux ensuite que la macro effectue le même processus sur la ligne suivante (valide si V5 < 0, si oui copie le contenu de l'onglet Individual Summary dans le nouvel onglet "New Summary" en dessous de celui de l'étape précédente, et inscrit le ID number (cellule a5 du fichier Master) dans le champs PerNer du fichier ajouté.
Si le différentiel >=0 je veux que la macro passe à la ligne suivante.
J'ai réussi à faire la macro qui génère l'info de la première ligne mais ça s'arrête là…
Sub Sommaire()
'
' Sommaire Macro
' génère les sommaire si différentiel est < 0
'
' Touche de raccourci du clavier: Ctrl+Shift+S
'
Range("V4").Select
Sheets("Individual Summary").Select
Rows("1:27").Select
Selection.Copy
Sheets("New summary").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Master").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("New summary").Select
Range("C3").Select
ActiveSheet.Paste
End Sub
Salut Jojo,
2 macros pour le prix d'une :
- une qui démarre sur un double-clic sur la cellule "Différentiel" pour un traitement global de la feuille ;
- une autre qui démarre lors d'un changement de valeur individuelle dans la colonne "Différentiel" pour le traitement immédiat d'une seule ligne.
Cette macro est neutralisée, les instructions étant mises en commentaire. Si elle est inutile, à supprimer!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%, iCol%
'
Application.ScreenUpdating = False
'
iRow = Target.Row
iCol = Target.Column
'
If Target = "Différentiel" And Range("A" & iRow + 1).Value <> "" Then
Cancel = True
With Worksheets("New Summary")
For x = iRow + 1 To Range("A" & Rows.Count).End(xlUp).Row
If CDbl(Cells(x, iCol)) < 0 Then _
iRowT = IIf(.[A3] = "", 1, .UsedRange.Rows.Count + 1): _
Worksheets("Individual Summary").Range("A1:L26").Copy: _
.Range("A" & iRowT & ":L" & iRowT + 25).PasteSpecial xlPasteAll: _
.Range("A" & iRowT & ":L" & iRowT + 25).PasteSpecial xlPasteColumnWidths: _
.Range("C" & iRowT + 2).Value = CLng(Range("A" & x).Value)
Next
Application.CutCopyMode = False
End With
End If
Application.ScreenUpdating = True
'
End Sub
A+
Un immense merci ça fonctionne!