IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Macro : Copier/coller par ligne [XL-2016]


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti
    Profil pro
    Inscrit en
    Août 2006
    Messages
    21
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 21
    Par défaut Macro : Copier/coller par ligne
    Bonjour,

    Je souhaite créer 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.

    Exemple

    Quand j'ajoute un X sur la cellule E4, j'ai un copier/coller des cellules H4: V4 + un "X" qui s'indique dans la cellule B4 + entrée à la fin.

    Avez vous une idée ?

    Merci

  2. #2
    Expert éminent Avatar de Menhir
    Homme Profil pro
    Ingénieur
    Inscrit en
    Juin 2007
    Messages
    16 037
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2007
    Messages : 16 037
    Par défaut
    Citation Envoyé par sylvain78 Voir le message
    Lorsqu'un X est indiqué en colonne AP alors la macro se déclenche
    Utilise l'évènement Worksheet_Change, en commençant par vérifier que la cellule modifiée appartient à la colonne AP.
    https://msdn.microsoft.com/fr-fr/lib...5(v=office.15)

    copier/coller les valeurs de la colonne H à V
    Pour la copie : https://msdn.microsoft.com/fr-fr/lib...0(v=office.15)
    Pour le collage de valeur, utilise PasteSpecial avec l'option xlPasteValues : https://msdn.microsoft.com/fr-fr/lib...6(v=office.15)

    puis il rajoute une croix dans la colonne B + entrée.
    Modifier la propriété Value de la cellule : https://msdn.microsoft.com/fr-fr/lib...3(v=office.15)

  3. #3
    Membre averti
    Profil pro
    Inscrit en
    Août 2006
    Messages
    21
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 21
    Par défaut
    Merci de ta réponse ! Je débute en VBA est-ce que tu peux me corriger :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRgSel As Range
    Set xRgSel = Range("AP1:AP200")
    Set xRgSel = Intersect(Target, xRg)
    With Worksheets("Sheet1") 
     .Range("H:V").Copy 
     .Range("H:V").PasteSpecial _ 
      Operation:=xlPasteValues
    Worksheets("Sheet1").Range("A").Value = "X"
    End With
    End Sub
    De plus cela sera sur des cellules protégé est-ce que cela pose problème ?

    Merci

  4. #4
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Citation Envoyé par sylvain78 Voir le message
    Je débute en VBA est-ce que tu peux me corriger
    J'aurais écris :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    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  'et éventuellement le mot de passe (inutile à mon avis)
    End Sub

  5. #5
    Membre averti
    Profil pro
    Inscrit en
    Août 2006
    Messages
    21
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 21
    Par défaut
    Merci Patrice,

    Malheureusement ça ne marche pas pour la partie copier/coller valeurs.

    J'ai essayé de modifier ton code, pour le copier/coller

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    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 (1234)
      For Each cel In xRgSel.Cells
        If UCase(cel.Value) = "X" Then
    Sheets("A").Range("C:H").Copy
    Sheets("A").Range("C:H").PasteSpecial xlPasteValues
          rng.Value = rng.Value
          cel.EntireRow.Cells(1, "B").Value = "X"
      End If
      Next cel
      Me.Protect (1234) 'et éventuellement le mot de passe (inutile à mon avis)
    End Sub
    Or ça copie/colle sur la colonne C à H, mais je souhaite uniquement le faire sur la ligne correspondant à l'ajout du X

    Je ne sais pas comment faire

  6. #6
    Membre averti
    Profil pro
    Inscrit en
    Août 2006
    Messages
    21
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 21
    Par défaut
    Au final je viens de réessayer et ça marche ! Je ne sais pas pourquoi, j'ai du faire une fausse manip hier !

    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

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    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

  7. #7
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Citation Envoyé par sylvain78 Voir le message
    Merci Patrice,
    Malheureusement ça ne marche pas pour la partie copier/coller valeurs.
    J'ai essayé de modifier ton code, pour le copier/coller
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRgSel As Range, cel As Range, rng As Range
      '...
    Sheets("A").Range("C:H").Copy
    Sheets("A").Range("C:H").PasteSpecial xlPasteValues
      '...
    C'est normal queça ne fonctionne pas, ton code n'est pas bon : tu copies des colonnes entières au lieu de copier uniquement la ligne concernée.

    Tu devrais analyser chaque instruction du code que je t'ai proposé pour en comprendre le fonctionnement (Utilises F1).

    D'autre par tu nommes la feuille "A", ce qui non seulement est inutile, mais est une source d'erreur potentielle pour deux raisons :
    - Un objet Sheet ne contient par de Range, le Range appartient à Worksheet, donc Sheet("A").Range n'est pas une syntaxe correcte, même si elle fonctionne dans certains cas.
    - Dans un module de feuille, lorsque la feuille n'est pas précisée un Range concerne la feuille dans laquelle se trouve la macro : si tu renommes la feuille, ça continue à fonctionner.
    Il faut aussi éviter d'utiliser le presse papier (.Copy puis .Paste), c'est le rôle du rng.Value = rng.Value

    Citation Envoyé par sylvain78 Voir le message
    Au final je viens de réessayer et ça marche ! Je ne sais pas pourquoi, j'ai du faire une fausse manip hier !
    Il n'y a pas de raison pour que ça fonctionne correctement, à moins d'avoir modifié le code que tu as publié !

    Il fallait simplement modifier l'adresse des colonnes à copier, voici mon code intégré à ton ancienne macro :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRgSel As Range, cel As Range, rng As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
        Application.ScreenUpdating = False
        Set xRg = Range("AP1:AP200")
        Set xRgSel = Intersect(Target, xRg)
        If Not xRgSel Is Nothing Then
            Me.Unprotect 1234
            For Each cel In xRgSel.Cells
                If UCase(cel.Value) = "X" Then
                    Set rng = Intersect(cel.EntireRow, Me.Columns("C:H"))
                    rng.Value = rng.Value
                    cel.EntireRow.Cells(1, "B").Value = "X"
                End If
            Next cel
            Me.Protect 1234
        End If
        Set xRgSel = Range("B4:B273")
        Set xRgSel = Intersect(Target, xRgSel)
        ActiveWorkbook.Save
        If Not xRgSel Is Nothing Then
            On Error Resume Next
            Application.DisplayAlerts = False
            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
            Application.DisplayAlerts = True
            On Error GoTo 0
        End If
        Application.ScreenUpdating = True
    End Sub

  8. #8
    Membre averti
    Profil pro
    Inscrit en
    Août 2006
    Messages
    21
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 21
    Par défaut
    Un grand merci à toi Patrice pour ton temps mais également pour tes explications très clairs !! MERCI

  9. #9
    Membre averti
    Profil pro
    Inscrit en
    Août 2006
    Messages
    21
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 21
    Par défaut
    Bonjour à tous,

    J'ai un problème avec ce code, en effet lors du copier/coller il me décale les valeurs situés entre H et V ?

    A savoir j'ai des colonnes masqués à l'intérieur est-ce que ça serait un début de réponse ?

    Merci

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Macro copier/coller avec supression des lignes vers autre feuille Excel
    Par soumaya88 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 24/07/2017, 22h29
  2. [2010] Copier / Coller des ligne d'une feuille avec Macro
    Par momojoker dans le forum Microsoft Office
    Réponses: 0
    Dernier message: 18/11/2015, 16h26
  3. [XL-2010] Macro copier coller en insérant ligne
    Par franklinbnj dans le forum Macros et VBA Excel
    Réponses: 26
    Dernier message: 18/03/2015, 10h29
  4. macro copier coller une ligne d'un tableau dans une autre feuille
    Par sonichou dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 27/07/2011, 22h13
  5. [WD-2007] Copier coller par macro
    Par jeanbifle_88 dans le forum VBA Word
    Réponses: 2
    Dernier message: 04/05/2011, 09h41

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo