Macro copier/coller par rapport au numéro de ligne

sylvain78b

XLDnaute Nouveau
Re(bonjour),

J'ai un dernier soucis avec mon classeur Excel.

Je souhaite créer une macro qui copie/colle (pour effacer les formules recherches V) ma ligne active.

Dans l'exemple ci-joint, quand je clique sur la check box E4, j'ai un copier/coller des cellules B4: D4 + un "Oui" qui s'indique dans la cellule A4 + entrée à la fin.

Je souhaite le faire pour E5 sur les valeurs B5: D5 + Oui en cellule A5 + entrée à la fin, etc...

Est-ce possible ?

Merci beaucoup
 

Fichiers joints

sylvain78b

XLDnaute Nouveau
J'ai essayé de changer de procéder par une macro qui copie/colle mes valeurs (pour effacer les formules) sur ma ligne active. Lorsqu'un X est indiqué en colonne AP alors la macro se déclenche pour copier/coller les valeurs de la colonne H à V, puis il rajoute une croix dans la colonne B + entrée.

J'ai réussi avec ce code :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range, cel As Range, rng As Range
  Set xRgSel = Range("AP1:AP200")
  Set xRgSel = Intersect(Target, xRgSel)
  If xRgSel Is Nothing Then Exit Sub
  Me.Unprotect
  For Each cel In xRgSel.Cells
    If UCase(cel.Value) = "X" Then
      Set rng = Intersect(cel.EntireRow, Me.Columns("H:V"))
      rng.Value = rng.Value
      cel.EntireRow.Cells(1, "B").Value = "X"
  End If
  Next cel
  Me.Protect  
End Sub
Mais j'ai un problème j'ai déjà un code VBA sur cette même feuille, comment faire pour mettre celle-ci à la suite ?

Voici mon 1er code VBA

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("B4:B273")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Bonjour à tous," & vbNewLine & vbNewLine & _
        "Un nouvel " & Cells(Target.Row, 25) & " à été ajouté " & Cells(Target.Row, 8) & " (" & Cells(Target.Row, 9) & ")" & " dans le fichier, en cellule " & xRgSel.Address(False, False) & _
            "' le " & _
            Format$(Now, "mm/dd/yyyy") & " à " & Format$(Now, "hh:mm") & _
            " par " & Environ$("username") & "." & vbNewLine & vbNewLine & _
            "Pour rappel le fichier est consultable à cette adresse : " & ThisWorkbook.FullName & vbNewLine & vbNewLine & _
            "Merci par avance pour votre validation express," & vbNewLine & vbNewLine & _
            ""
        With xMailItem
            .To = Cells(Target.Row, 14) & Cells(Target.Row, 18)
            .Cc = ""
            .Subject = "Validation de votre part "
            .Body = xMailBody
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Merci
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas