VBA copier collé automatique d'un feuille à une autres
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)
2-qui ouvre l'onglet aide et me demande de sélectionner la ligne à copier
3-Qui copie les valeurs et seulement les valeurs non nulle de la ligne choisie
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")
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
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
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
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 ?
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)
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
- 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
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"
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"
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"
Je te remet le fichier avec la macro
Merci beaucoup.
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.
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
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
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
Merci Dan, pas toujours facile d'exprimer ce que l'on à en tête!
Bonne journée
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
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.
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
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
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
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