VBA copier collé automatique d'un feuille à une autres

Le 06/03/2024 à 18:18

Bonjour, devenu accro de l'Excel et de l'optimisation, je me lance dans un nouveau code VBA. Malheureusement je n'ai clairement pas les compétence pour réaliser ce que je souhaiterai faire ici. C'est pour cela que je demande à nouveau votre aide.

J'aimerai créer une VBA qui :

1-copie la ligne 448 dans l'onglet DS et la colle en insérant au dessus de la ligne choisie (pour cette exemple ligne 7)

image

2-qui ouvre l'onglet aide et me demande de sélectionner la ligne à copier

image

3-Qui copie les valeurs et seulement les valeurs non nulle de la ligne choisie

capture d ecran 2024 03 06 180608

4-et qui les colles sur la ligne 7 en respectant les l'emplacement des colonnes initiale Exemples : ( B16 "onglet aide" collé -> B7 "onglet DS") (C16 "onglet aide" collé -> C7 "onglet DS") (O16 "onglet aide" collé -> O7 "onglet DS")

capture d ecran 2024 03 06 180126

Attentions, il ne faut pas que le collage efface les formules en A7, H7, I7, J7 dans l'onglet DS etc...

Je vous remercie grandement pour votre aide.

Je joint le fichier en question.

Merci

9dpgftestvba.zip (294.32 Ko)
Le 08/03/2024 à 15:14

Bonjour,

Essayez avec ce code à placer dans un module que vous devez créer dans l'éditeur VBA via le menu Insertion

Sub test()
Dim lg As Range
Dim ligne As Range

With Sheets("Aide")
    On Error Resume Next
    Set lg = Application.InputBox("choisissez une cellule ou une plage", Type:=8)
    If lg = vbNullString Then
        MsgBox "veuillez sélectionner une ligne entière ou une cellue dans votre tableau de la feuille " & Sheets("Aide").Name, vbCritical, "Erreur sélection"
        Exit Sub
    End If

    If Selection.Rows.Count = 1 Then
        Sheets("D.S.").Activate
        Set ligne = Application.InputBox("choisissez une cellule ou une plage", Type:=8)

        With Sheets("Aide")
            .Cells(lg.Row, 2).Resize(, 6).Copy
            ActiveSheet.Range("B" & ligne.Row).PasteSpecial Paste:=xlPasteValues
            .Cells(lg.Row, 16).Resize(, 3).Copy
            ActiveSheet.Range("Q" & ligne.Row).PasteSpecial Paste:=xlPasteValues
            ActiveSheet.Range("O" & ligne.Row) = .Cells(lg.Row, 14).Value
            ActiveSheet.Range("U" & ligne.Row) = .Cells(lg.Row, 20).Value
            ActiveSheet.Range("W" & ligne.Row) = .Cells(lg.Row, 22).Value
        End With
    End If
End With
End Sub

Cordialement

Le 14/03/2024 à 17:43

Bonjour dan,

Désole pour le délais de réponse mais j'étais en vacance.

Déja merci pour ta réponse, cela semble fonctionner mais le problème c'est que la macro ne colle pas les formules (juste des valeurs).

Est t'il possible de changer cela?

Merci

Le 14/03/2024 à 18:25

Bonjour,

Dans la demande vous écrivez ceci...

Qui copie les valeurs et seulement les valeurs non nulle de la ligne choisie

de quelles formules parlez -vous ?

Il y a des cellules qui renvoient valeurs parce que l'info doit venir de la feuille Aide
Exemple : la colonne J (COFIX) dans la feuille DS, on la pêche où dans la feuille Aide ?

Le 15/03/2024 à 15:06

Bonjour Dan,

En effet je me suis mal exprimé désolé, je reprend donc le numero 3

3-Qui copie les formules de toute la ligne si il y a une formule (exemple dans onglet Aide, en G10, il y a une formule "=C16")
3-Qui copie le texte de toute la ligne si il y a un texte (exemple dans dans onglet Aide, en U16, il y a un texte "m2")
3-Qui ne copie pas les cellule vide de la ligne (exemple en H16)

image

Concernant la colonne COFIX, c'était une erreur, je viens de la rajouter dans l'onglet AIDE. En PJ le nouveau fichier

Merci pour ton aide

2dpgftestvba2.zip (248.06 Ko)
Le 15/03/2024 à 18:22

- Votre fichier ne contient pas de code..

3-Qui copie les formules de toute la ligne si il y a une formule (exemple dans onglet Aide, en G10, il y a une formule "=C16")

Heu, moi j'ai C10 et pas C16

Je n'avais pas besoin du fichier qui est identique au précédent je crois.

Pour copier les valeurs et formules, allez dans le code proposé et remplacez ces 4 lignes

.Cells(lg.Row, 2).Resize(, 6).Copy
ActiveSheet.Range("B" & ligne.Row).PasteSpecial Paste:=xlPasteValues
.Cells(lg.Row, 16).Resize(, 3).Copy
ActiveSheet.Range("Q" & ligne.Row).PasteSpecial Paste:=xlPasteValues

par ces deux-ci

.Cells(lg.Row, 2).Resize(, 6).Copy ActiveSheet.Range("B" & ligne.Row)
.Cells(lg.Row, 16).Resize(, 3).Copy ActiveSheet.Range("Q" & ligne.Row)

cordialement

Le 18/03/2024 à 11:10

Bonjour Dan,

encore merci pour ton aide.

Comme tu peux le voir, il y a un décalage vers la droite de donnée, certainement due à l'ajout de colonnes COFIX dans l'onglet "Aide"

image

Il n'a pas copié toute la ligne (exemple en cellule 8W) qui selon l'onglet "aide" devrai avoir copié la formule "=G8*3,5"

image

Il n'a pas copié toute la ligne (exemple en cellule 8AJ et 8AK et 8AN) qui selon l'onglet "aide" devrai avoir copié respectivement la formule "b" puis "1" enfin "=G18*10"

image

Je te remet le fichier avec la macro

2dpgftestvba2.zip (258.03 Ko)

Merci beaucoup.

Le 18/03/2024 à 15:34

Bonjour

Oui normal tout est décalé dû à votre colonne Cofix.
Pour info, dans les lignes du code, le chiffre 16 devient 17, le 20 devient 21, et le 22 devient 23.

Puis pour les colonnes au delà de X, vous n'aviez pas précisé cela.
Pourriez-vous confirmer qu'au delà de X il n'y a bien que les colonnes AJ, AK et AN à copier vers DS

Je vous reposterai le code complet

Merci de ne me reposter pas votre fichier.

Le 18/03/2024 à 18:09

Re bonjour dan,

Merci pour ta patience.

En effet toutes les cellules non vide de la ligne de l'onglet "aide" doivent être copié et collé dans l'onglet "DS"

Bonne soirée

Le 18/03/2024 à 18:24

En effet toutes les cellules non vide de la ligne de l'onglet "aide" doivent être copié et collé dans l'onglet "DS"

Donc les cellules Y à AK et AM à AV ?
Pas la colonne AL

Le 20/03/2024 à 09:49

Bonjour dan,

oui toutes les cellules de A à AV de l'onglet "Aide" doivent être copier et coller dans l'onglet "DS"

La seule condition c'est que les cellules de l'onglet "Aide" ne soit pas vide

Si une cellules de l'onglet "Aide" est vide, il ne faut pas la copier et coller car cela écraserai les cellules dans l'onglet "DS"

Voici un exemple pour la ligne 8 de l'onglet "AIDE" seul les cellules B8, C8, D8, E8, F8, G8, O8, Q8, R8, S8 seront copier et coller

image image

Merci Dan, pas toujours facile d'exprimer ce que l'on à en tête!

Bonne journée

Le 20/03/2024 à 11:54

Bonjour

Mais lorsque vous avez une formule en DS, il ne faut pas aller l'enlever. Raison pour laquelle je vous demandais au sujet des colonnes dans mon message précédent

La seule condition c'est que les cellules de l'onglet "Aide" ne soit pas vide

Bah si c'est vide, que l'on copie ou pas. Ce sera toujours vide en DS

Voici un exemple pour la ligne 8 de l'onglet "AIDE" seul les cellules B8, C8, D8, E8, F8, G8, O8, Q8, R8, S8 seront copier et coller

Mais là c'est déjà fait avec le code. Cela ne résoud pas le souci dont vous parliez avant.
Dans le code je considère que l'on ne copie depuis Aide que les cellules où vous n'avez pas de formule en DS

Essayez le code comme ceci dans votre dernier fichier postéSub copiercoller()Dim lg As RangeDim ligne As Range

With Sheets("Aide")
    On Error Resume Next
    Set lg = Application.InputBox("choisissez une cellule sur la ligne à copier", Type:=8) 'selection de 1 cellule de la ligne à copier
    If lg = vbNullString Then
        MsgBox "veuillez sélectionner une cellule de la ligne à copier dans le tableau de la feuille " & Sheets("Aide").Name, vbCritical, "Erreur sélection"
        Exit Sub
    End If

    If Selection.Rows.Count = 1 Then
        Sheets("D.S.").Activate
        Set ligne = Application.InputBox("choisissez une cellule sur la ligne de destination", Type:=8) 'selection de 1 cellule de la ligne à coller
        With Sheets("Aide")
            .Cells(lg.Row, 17).Resize(, 3).Copy ActiveSheet.Range("Q" & ligne.Row) 'copie des colonnes Q à S vers colonne Q à S feuille DS
            .Cells(lg.Row, 25).Resize(, 13).Copy ActiveSheet.Range("Y" & ligne.Row)'copie des colonnes Y à AK vers colonne Y à AK feuille DS
            .Cells(lg.Row, 40).Resize(, 9).Copy ActiveSheet.Range("AN" & ligne.Row)'copie des colonnes AN à AV vers colonne AN à AV feuile DS
            ActiveSheet.Range("O" & ligne.Row) = .Cells(lg.Row, 15).Value 'copie cellule en colonne O vers colonne O en feuille DS
            ActiveSheet.Range("U" & ligne.Row) = .Cells(lg.Row, 21).Value 'copie cellule en colonne U vers colonne U en feuille DS
            ActiveSheet.Range("W" & ligne.Row) = .Cells(lg.Row, 23).Value 'copie cellule en colonne W vers colonne W en feuille DS
        End With
    End If
End With
End Sub

Crdlt

Le 20/03/2024 à 14:20

Bonjour dan,

Merci j'y vois plus claire mais je viens d'essayer le code mais j'ai pas l'impression que ca fonctionne pas, car seul la ligne Q R et S sont copiée.

Ok partons sur le principe que seule les cases vides correspondante dans "DS" sont copié et collé depuis "aide" donc il faudrait copier et coller systematiquement les cellules:

A B C D E F G J O Q R S U W Y Z AA AB AC AD AE AF AG AH AJ AK AN AO AP AQ AR AS AT AU AV

Pas la J car inutile dans ce cas de figure

Merci encore.

Le 20/03/2024 à 17:12

Merci j'y vois plus claire mais je viens d'essayer le code mais j'ai pas l'impression que ca fonctionne pas, car seul la ligne Q R et S sont copiée

Non du tout. Tout est copié. Maintenant si vous n'avez pas de données .... dans les cellules
Par contre j'ai modifié les 3 dernière ligne dans la partie with sheets("Aide")....end with. Les colonnes 14, 20 et 22 étaient en fait les colonnes 15, 21 et 23

Je vous ai ajouté un commentaire dans les cellules copiées pour que vous compreniez
Le mieux est que vous repreniez le code complet

Si soucis dites moi mais merci de ne pas postez de fichier

Le 21/03/2024 à 14:39

Bonjour dan,

merci pour l'aide de vais prendre le temps d'essayer de comprendre le code et je reviendrai vers vous dans les prochains jours.

Merci

Le 21/03/2024 à 15:20

vais prendre le temps d'essayer de comprendre le code

Ok. N'hésitez pas.
Les commentaires devraient vous aider à comprendre

Si tout est bon, pensez à

Cordialement

Le 28/03/2024 à 14:34

Bonjour DAN apres quelques recherches infructueuses j'ai enfin trouver le bon code.

Je te remercie infiniment pour ton aide precieuse.

A bientot

Sub Aide()
With Sheets("Aide")
    On Error Resume Next
    Set lg = Application.InputBox("choisissez une cellule sur la ligne à copier", Type:=8) 'selection de 1 cellule de la ligne à copier
    If lg = vbNullString Then
        MsgBox "veuillez sélectionner une cellule de la ligne à copier dans le tableau de la feuille " & Sheets("Aide").Name, vbCritical, "Erreur sélection"
        Exit Sub
    End If

    If Selection.Rows.Count = 1 Then
        Sheets("D.S.").Activate
        Set ligne = Application.InputBox("choisissez une cellule sur la ligne de destination", Type:=8) 'selection de 1 cellule de la ligne à coller
        With Sheets("Aide")
            .Cells(lg.Row, 2).Resize(, 1).Copy ActiveSheet.Range("B" & ligne.Row) 'copie des colonnes Q à S vers colonne Q à S feuille DS
            .Cells(lg.Row, 6).Resize(, 1).Copy ActiveSheet.Range("F" & ligne.Row)
            .Cells(lg.Row, 7).Resize(, 1).Copy ActiveSheet.Range("G" & ligne.Row)
            .Cells(lg.Row, 15).Resize(, 1).Copy ActiveSheet.Range("O" & ligne.Row)
            .Cells(lg.Row, 17).Resize(, 1).Copy ActiveSheet.Range("Q" & ligne.Row)
            .Cells(lg.Row, 18).Resize(, 1).Copy ActiveSheet.Range("R" & ligne.Row)
            .Cells(lg.Row, 19).Resize(, 1).Copy ActiveSheet.Range("S" & ligne.Row)
            .Cells(lg.Row, 21).Resize(, 1).Copy ActiveSheet.Range("U" & ligne.Row)
            .Cells(lg.Row, 23).Resize(, 1).Copy ActiveSheet.Range("W" & ligne.Row)
            .Cells(lg.Row, 25).Resize(, 1).Copy ActiveSheet.Range("Y" & ligne.Row)
            .Cells(lg.Row, 26).Resize(, 1).Copy ActiveSheet.Range("Z" & ligne.Row)
            .Cells(lg.Row, 27).Resize(, 1).Copy ActiveSheet.Range("AA" & ligne.Row)
            .Cells(lg.Row, 28).Resize(, 1).Copy ActiveSheet.Range("AB" & ligne.Row)
            .Cells(lg.Row, 29).Resize(, 1).Copy ActiveSheet.Range("AC" & ligne.Row)
            .Cells(lg.Row, 30).Resize(, 1).Copy ActiveSheet.Range("AD" & ligne.Row)
            .Cells(lg.Row, 31).Resize(, 1).Copy ActiveSheet.Range("AE" & ligne.Row)
            .Cells(lg.Row, 32).Resize(, 1).Copy ActiveSheet.Range("AF" & ligne.Row)
            .Cells(lg.Row, 33).Resize(, 1).Copy ActiveSheet.Range("AG" & ligne.Row)
            .Cells(lg.Row, 34).Resize(, 1).Copy ActiveSheet.Range("AH" & ligne.Row)
            .Cells(lg.Row, 36).Resize(, 1).Copy ActiveSheet.Range("AJ" & ligne.Row)
            .Cells(lg.Row, 37).Resize(, 1).Copy ActiveSheet.Range("AK" & ligne.Row)
            .Cells(lg.Row, 40).Resize(, 1).Copy ActiveSheet.Range("AN" & ligne.Row)
            .Cells(lg.Row, 41).Resize(, 1).Copy ActiveSheet.Range("AO" & ligne.Row)
            .Cells(lg.Row, 42).Resize(, 1).Copy ActiveSheet.Range("AP" & ligne.Row)
            .Cells(lg.Row, 43).Resize(, 1).Copy ActiveSheet.Range("AQ" & ligne.Row)
            .Cells(lg.Row, 44).Resize(, 1).Copy ActiveSheet.Range("AR" & ligne.Row)
            .Cells(lg.Row, 45).Resize(, 1).Copy ActiveSheet.Range("AS" & ligne.Row)
            .Cells(lg.Row, 46).Resize(, 1).Copy ActiveSheet.Range("AT" & ligne.Row)
            .Cells(lg.Row, 47).Resize(, 1).Copy ActiveSheet.Range("AU" & ligne.Row)
            .Cells(lg.Row, 48).Resize(, 1).Copy ActiveSheet.Range("AV" & ligne.Row)
        End With
    End If
End With
End Sub
Rechercher des sujets similaires à "vba copier colle automatique feuille"