Copie lignes sélectionnées ds 1 feuille avec nom choisi par l'utilisateur

Question

Vu mon niveau en vba, impossible pour moi de résoudre mon problème, d’où ma demande. Le code demandé devrait copier à partir de la feuille "Issus" les lignes sélectionnées par l'utilisateur pour les coller dans la feuille du choix de l'utilisateur, ce qui veux dire que le nom de la feuille sera demandé à l'utilisateur. La feuille "Issus" contient 11 colonnes et un nombre de lignes importantes et variables. J'ai réduit le nombre des lignes pour les besoins de cette demande. Information : Pour un gain de temps lorsque l'utilisateur sélectionne les lignes à copier, il va seulement sélectionner une seule cellule pour chaque ligne concernée mais pas la totalité de la ligne, en plus, les lignes sélectionnées ne sont pas toujours les unes à côtés des autres, parfois, elles le sont et parfois elles ne le sont pas. Le code mis en place doit tenir compte de deux cas de figure : Premier cas : si le nom de la feuille mentionné par l'utilisateur n'existe pas, alors, il faut la créer en prenant soin de mettre à la première ligne les mêmes entêtes qui se trouvent dans la feuille "Issus" et seulement après on copie les lignes sélectionnées. Deuxième cas : si la feuille existe, alors, deux possibilités se présentent à nous : On demande à l'utilisateur s'il souhaite garder les anciennes données existantes, si la réponse est "oui", dans ce cas, on se place à la première ligne vide en dessous des lignes existantes pour y copier les nouvelles données. Si l'utilisateur ne souhaite pas garder les anciennes données, dans ce cas, on efface les données existantes depuis la 2 e ligne jusqu'à la dernière ligne et puis seulement après on colle les lignes sélectionnées à partir de la deuxième ligne, puisque la première ligne contient déjà les mêmes entêtes comme dans la feuille "Issus". J'espère que j'étais clair dans mes explications pour vous permettre à m'aider à solutionner mon problème, toutefois, je reste à votre disposition pour d'autres informations complémentaires...

Rag02700 · Accepted Answer

A tester (Il faudra décaler le bouton après la colonne K) : Me dire si besoin de commentaires Sub CopierLignesSélectionnées() Dim strWksName As String Dim WksPaste As Worksheet Dim rng As Range Dim i As Long, x As Long Dim intArrRow() As Long Dim varAnswer As Variant Application.ScreenUpdating = False If Not Selection.Count = 0 Then ReDim intArrRow(1 To Selection.Count) i = 1 For Each rng In Selection.Rows intArrRow(i) = rng.Row i = i + 1 Next rng strWksName = InputBox("Nom de la feuille ?") On Error Resume Next Set WksPaste = Worksheets(strWksName) If Err.Number = 0 Then On Error GoTo 0 varAnswer = MsgBox("Conserver les données de la feuille ?", vbYesNo) If varAnswer = vbYes Then x = WksPaste.Cells(WksPaste.Rows.Count, 1).End(xlUp).Row + 1 For i = LBound(intArrRow) To UBound(intArrRow) Feuil1.Range("a" & intArrRow(i) & ":k" & intArrRow(i)).Copy WksPaste.Range("a" & x) x = x + 1 Next i Else WksPaste.Range("a2:k500000").ClearContents x = 2 For i = LBound(intArrRow) To UBound(intArrRow) Feuil1.Range("a" & intArrRow(i) & ":k" & intArrRow(i)).Copy WksPaste.Range("a" & x) x = x + 1 Next i End If Else On Error GoTo 0 Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = strWksName Set WksPaste = Worksheets(strWksName) Feuil1.Range("a1:k1").Copy WksPaste.Range("a1") x = 2 For i = LBound(intArrRow) To UBound(intArrRow) Feuil1.Range("a" & intArrRow(i) & ":k" & intArrRow(i)).Copy WksPaste.Range("a" & x) x = x + 1 Next i End If End If Application.ScreenUpdating = True End Sub...

Rag02700 · Accepted Answer

Voici avec la prise en compte de la nouvelle demande : Sub CopierLignesSélectionnées() Dim strWksName As String Dim WksPaste As Worksheet Dim rng As Range Dim i As Long, x As Long Dim intArrRow() As Long Dim varAnswer As Variant, varExist As Variant Application.ScreenUpdating = False If Not Selection.Count = 0 Then ' Si des cellules sont sélectionnées (1 seule par ligne) ' ##### On stock en mémoire les numéros des lignes séléctionnées ###### ReDim intArrRow(1 To Selection.Count) i = 1 For Each rng In Selection.Rows intArrRow(i) = rng.Row i = i + 1 Next rng '############################################ strWksName = InputBox("Nom de la feuille ?") 'Demande le nom d'une feuille On Error Resume Next Set WksPaste = Worksheets(strWksName) 'Definit la feuille If Err.Number = 0 Then 'Si pas d'erreur, elle existe sinon elle n'existe pas On Error GoTo 0 varAnswer = MsgBox("Conserver les données de la feuille ?", vbYesNo) 'Demande si on conserve les données If varAnswer = vbYes Then 'Si oui x = WksPaste.Cells(WksPaste.Rows.Count, 1).End(xlUp).Row + 1 'Def de la premiere ligne vide For i = LBound(intArrRow) To UBound(intArrRow) 'copie colle les lignes dans la nouvelle feuille 'Cherche si le jeune existe déjà varExist = Application.WorksheetFunction.Match(Feuil1.Range("a" & intArrRow(i)).Value, WksPaste.Range("a:a"), 0) 'si non ajout du jeune If IsError(varExist) Then Feuil1.Range("a" & intArrRow(i) & ":k" & intArrRow(i)).Copy WksPaste.Range("a" & x) x = x + 1 Next i Else 'Si non WksPaste.Range("a2:k500000").ClearContents 'Vide les données x = 2 For i = LBound(intArrRow) To UBound(intArrRow) 'copie colle les lignes dans la nouvelle feuille Feuil1.Range("a" & intArrRow(i) & ":k" & intArrRow(i)).Copy WksPaste.Range("a" & x) x = x + 1 Next i End If Else 'Si feuille non existante On Error GoTo 0 Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = strWksName 'Ajout de la feuille Set WksPaste = Worksheets(strWksName) 'Definit la nouvelle feuille Feuil1.Range("a1:k1").Copy WksPaste.Range("a1") 'Copie colle les en-tetes x = 2 For i = LBound(intArrRow) To UBound(intArrRow) 'copie colle les lignes dans la nouvelle feuille Feuil1.Range("a" & intArrRow(i) & ":k" & intArrRow(i)).Copy WksPaste.Range("a" & x) x = x + 1 Next i End If End If Application.ScreenUpdating = True End Sub...