Copy the 3 column cells: A - B and C of the selected row

harzer

Board Regular
Joined
Dec 15, 2021
Messages
122
Office Version
  1. 2016
Platform
  1. Windows
My request was written in French and translated into English.

Hello everyone,
I am coming to you because I cannot solve my copy and paste problem.
I will be as clear as possible in my request to make your job easier so you can provide a solution.
If you will allow it, I would like a solution in vba.

My issue is the following :
Via a button placed on the "B_D" sheet, if I place myself in any cell of the following columns: (“B: J“) or (“L: M“) or (“O: V“), we must be able to find the number of the selected line. Columns “K“ and “N“ cannot be selected.
When the row number is determined, we read the cell of column “A” (of the same selected row) to find out if its last character is “F” or “M”.
For your information, the “F” stands for Female and the “M” stands for Male.
If the last character is “F” Then we select the 3 column cells: “A” & “B” & “C” of the selected row to copy them to the “W” “X” “Y” columns from line 2.
If on the other hand the last character is “M” Then we select the 3 cells of the columns: “A” & “B” & “C” of the selected line to copy them this time on the columns “AB” “AC” “AD” from line 2.
If I want to do the same thing again, the new copied results will be placed below the results already obtained.
We conclude:
All the columns ending with the character “F” should be found in column “W” and in column “AB” all cells ending with the letter “M”.
Another small detail, we could also write a code not to allow duplicates in the “W” and “AB” columns.
I remain at your disposal for any other additional information.
Thank you in advance for your suggestions.

------------------------------------------
Texte original en Français.
Bonjour à tous,
Je viens vers vous car je n’arrive pas à résoudre mon problème de copier-coller.
Je vais être le plus clair possible dans ma demande afin de vous faciliter le travail ainsi vous pouvez m’apporter une solution.
Si vous le permettez, j’aimerais une solution en vba.

Mon problème est le suivant :
Via un bouton placé sur la feuille "B_D", si je me place dans n’importe quelle cellule des colonnes suivantes : (“B : J“) ou (“L : M“) ou (“O : V“), on doit pouvoir trouver le numéro de la ligne sélectionnée. Les colonnes “K“ et “N“ ne peuvent pas être sélectionnées.
Lorsque le numéro de la ligne est déterminé, on lit la cellule de la colonne “A” (de la même ligne sélectionnée) pour savoir si son dernier caractère est “F” ou “M”.
Pour votre information, le “F” veut dire Femelle et le “M” veut dire Mâle.
Si le dernier caractère est “F” Alors on sélectionne les 3 cellules des colonnes : “A” & “B” & “C” de la ligne sélectionnée pour les copier sur les colonnes “W” “X” “Y” à partir de la ligne 2.
Si par contre le dernier caractère est “M” Alors on sélectionne les 3 cellules des colonnes : “A” & “B” & “C” de la ligne sélectionnée pour les copier cet fois-ci sur les colonnes “AB” “AC” “AD” à partir de la ligne 2.
Si je souhaite refaire la même chose, les nouveaux résultats copiés se mettront en dessous des résultats déjà obtenus.
On conclusion :
On devra trouver dans la colonne “W” toutes les colonnes se terminant par le caractère “F” et dans la colonne “AB” toutes les cellules se terminant par la lettre “M”.
Encore un petit détail, on pourrait écrire aussi un code pour ne pas autoriser les doublons dans les colonnes “W” et “AB”.
Je reste à votre disposition pour d’autres informations supplémentaires.
D’avance merci pour vos propositions.
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Hello,
I can't seem to put my excel file as an attachment, so I put an image hoping this will help you.

Bonjour,
Je n'arrive pas à mettre mon fichier Excel en pièce jointe, alors j'ai mis une image en espérant que cela va vous aider.
 

Attachments

  • Oiseaux_Elevage.png
    Oiseaux_Elevage.png
    50.9 KB · Views: 21
Upvote 0
Hello everyone,
I kept looking for a solution to my problem and finally found a solution!
I put it at your disposal if anyone is ever interested.
It is true that given my poor knowledge of vba, the solution I found is not elegant, but at least it has the merit of working.
If ever a well-waking spirit wishes to offer me a solution which will certainly be a solution much more gracious than mine.
Greetings.

Bonjour à tous,
J’ai continué à chercher une solution à mon problème et j’ai fini par trouver une solution !
Je la mets à votre disposition si jamais ça intéresse quelqu'un.
Il est vrai que vu mes piètres connaissances en vba, la solution que j’ai trouvée n’est pas élégante mais au moins elle a le mérite de fonctionner.
Si jamais un esprit bien veillant souhaite me proposer une solution qui sera certainement une solution beaucoup plus gracieuse que la mienne.
Salutations.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False
Dim Ligne As Integer
Dim DLig_col_W As Integer
Dim DLig_col_AB As Integer
Ligne = ActiveCell.Row
'Colonne = ActiveCell.Column

DLig_col_W = Range("W65000").End(xlUp).Row + 1
DLig_col_AB = Range("AB65000").End(xlUp).Row + 1
Rg = Cells(Target.Row, 1).Value

If Target.Count = 1 Then
If Not Intersect(Target, Columns("B:AD")) Is Nothing Then

''''''''''''''''''''''''''''''''''''debut du test pour savoir si la cellule que je souhaite ajouter existe déjà ds les colonne "W" et "AB" et éviter les doublons
For iCol_W = 2 To DLig_col_W
If Cells(iCol_W, 23).Value = Rg Then
'MsgBox Cells(iCol_W, 23).Value
'MsgBox ("L'oiseaux " & Rg & " est déjà existant et se trouve à la ligne " & iCol_W)
Cells(iCol_W, 23).Select
Exit Sub
End If
Next iCol_W

For iCol_AB = 2 To DLig_col_AB
'MsgBox Cells(iCol_AB, 28).Value
If Cells(iCol_AB, 28).Value = Rg Then
'MsgBox ("L'oiseaux " & Rg & " est déjà existant et se trouve à la ligne " & iCol_AB)
Cells(iCol_AB, 28).Select
Exit Sub
End If
Next iCol_AB
''''''''''''''''''''''''Fin de test des doublons dans les colonnes "W" et "AB"

' If Not Intersect(Target, Columns("W:W")) Or Not Intersect(Target, Columns("AB:AB")) Is Nothing Then
With Range("A" & Ligne)
If Right(.Value, 1) = "F" Then
NoLig_Col_W = ActiveSheet.Cells(Columns(23).Cells.Count, 23).End(xlUp).Row + 1
ActiveSheet.Cells(NoLig_Col_W, 23) = Range("A" & Target.Row)
ActiveSheet.Cells(NoLig_Col_W, 24) = Range("B" & Target.Row)
ActiveSheet.Cells(NoLig_Col_W, 25) = Range("C" & Target.Row)
End If

If Right(.Value, 1) = "M" Then
NoLig_Col_AB = ActiveSheet.Cells(Columns(28).Cells.Count, 28).End(xlUp).Row + 1
ActiveSheet.Cells(NoLig_Col_AB, 28) = Range("A" & Target.Row)
ActiveSheet.Cells(NoLig_Col_AB, 29) = Range("B" & Target.Row)
ActiveSheet.Cells(NoLig_Col_AB, 30) = Range("C" & Target.Row)
End If
End With
End If
End If
Application.ScreenUpdating = True

End Sub
 
Upvote 0

Forum statistics

Threads
1,214,830
Messages
6,121,839
Members
449,051
Latest member
excelquestion515

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top