Copier/coller si condition respectée

Le 01/09/2022 à 15:13

Bonjour, je suis débutant en VBA et je n'arrive pas à réaliser une macro assez simple. J'aimerai que lorsque une cellule de ma colonne Y comporte un certains contenu, cette dernière soit automatiquement copié et collé dans une autre feuille en colonne A à la suite ( vous verrez si dessous les contenus en question, ce sont des débuts de matricule produits qui comporte plus de chiffre mais qui contiennent chacun au moins ces deux caracteres au debut). Je ne sais spas pourquoi lorsque je fais le test, ma macro n'affiche aucun contenu et ne copie aucune cellule de la colonne Y dans ma fueille 2. J espere que l'un de vous pourrai m'eclairer. Merci beaucoup!.

Ma macro actuelle :

Sub matricule()
Workbooks("Macro.xlsm").Activate
Sheets("sheets1").Select

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To FinalRow
ThisValue = Cells(x, 25).Value

Workbooks("Macro.xlsm").Activate
Sheets("sheet1").Select
If ThisValue = "A3" Or ThisValue = "A4" Or ThisValue = "A5" Or ThisValue = "A6" Or ThisValue = "A8" Or ThisValue = "A9" Or ThisValue = "A2" Or ThisValue = "A1" Or ThisValue = "X1" _
Or ThisValue = "X2" Or ThisValue = "X3" Or ThisValue = "X4" Or ThisValue = "X6" Or ThisValue = "X7" Or ThisValue = "X8" Or ThisValue = "X9" _
Or ThisValue = "F0" Or ThisValue = "F2" Or ThisValue = "F3" Or ThisValue = "F4" Or ThisValue = "F5" Or ThisValue = "F6" Or ThisValue = "F7" Or ThisValue = "F8" Or ThisValue = "F9" _
Or ThisValue = "Z1" Or ThisValue = "Z2" Or ThisValue = "Z3" Or ThisValue = "Z4" Or ThisValue = "Z5" Or ThisValue = "Z6" Or ThisValue = "Z7" Or ThisValue = "Z8" Or ThisValue = "Z9" Then
Cells(x, 25).Copy

Sheets("sheet2").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste

End If

Next x

End Sub
Le 01/09/2022 à 17:28

Bonjour Thomas, bonjour le forum,

Peut-être comme ça :

Sub Thautheme()
Dim O1 As Worksheet 'déclare la variable O1 (Onglet 1)
Dim O2 As Worksheet 'déclare la variable O1 (Onglet 2)
Dim TF As Variant 'déclare la variable TF (Tableau des Formats)
Dim V As String 'déclare la variable V (Valeur)
Dim DL1 As Integer 'déclare la variable DL1 (Derière Ligne de l'onglet 1)
Dim DL2 As Integer 'déclare la variable DL2 (Derière Ligne de l'onglet 2)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Set O1 = Worksheets("sheets1") 'définit l'onglet O1
Set O2 = Worksheets("sheets2") 'définit l'onglet O2
'définit le tableau TF
TF = Array("A3", "A4", "A5", "A6", "A8", "A9", "A2", "A1", "X1", "X2", "X3", "X4", "X6", "X7", "X8", "X9", "F0", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "Z1", "Z2", "Z3", "Z4", "Z5", "Z6", "Z7", "Z8", "Z9")
DL1 = O1.Cells(Rows.Count, "Y").End(xlUp).Row 'définit la dernière ligne éditée de la colonne Y de l'onglet O1
For I = 2 To DL1 'boucle 1 : de 1 à DL1
    V = O1.Cells(x, 25).Value 'définit la valeur V
    For J = 1 To UBound(TF) 'boucle 2 : sur tous les éléments de TF
        If V = TF(I) Then 'condition : si là valeur V vaut l'élément de TF
            DL2 = O2.Cells(Rows.Count, "A").End(xlUp).Row + 1 'définit la dernière ligne éditée DL2 de la colonne A de l'onglet O2
            O2.Cells(DL2, "A").Value = V 'récupère la valeur V dans la cellule ligne DL2 colonne "A" de l'onglet O2
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochain élément de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

Non testé...

Le 02/09/2022 à 10:20

Bonjour ThauThème , je te remercie pour ta reponse.

Petit probleme, lorsque j'essaie d'effectuer ton code, j'ai une errreur d'execution '6' "depassement de capacité" sur la ligne :

DL1 = O1.Cells(Rows.Count, "Y").End(xlUp).Row

J'ai essayé avec Clng devant ca ne fonctionne pas non plus... :/

Le 02/09/2022 à 16:00

Re,

Sans le fichier qui va bien difficile de t'aider davantage...

Le 02/09/2022 à 16:16

Bonjour à tous!

thomas331301, un essai comme ceci

Option Compare Text
Sub matricule()
Dim F1, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil2")

FinalRow = F1.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To FinalRow
If Cells(x, 25) = "A3" Or Cells(x, 25) = "A4" Or Cells(x, 25) = "A5" Or Cells(x, 25) = "A6" Or Cells(x, 25) = "A8" Or Cells(x, 25) = "A9" Or Cells(x, 25) = "A2" Or Cells(x, 25) = "A1" Or Cells(x, 25) = "X1" _
Or Cells(x, 25) = "X2" Or Cells(x, 25) = "X3" Or Cells(x, 25) = "X4" Or Cells(x, 25) = "X6" Or Cells(x, 25) = "X7" Or Cells(x, 25) = "X8" Or Cells(x, 25) = "X9" _
Or Cells(x, 25) = "F0" Or Cells(x, 25) = "F2" Or Cells(x, 25) = "F3" Or Cells(x, 25) = "F4" Or Cells(x, 25) = "F5" Or Cells(x, 25) = "F6" Or Cells(x, 25) = "F7" Or Cells(x, 25) = "F8" Or Cells(x, 25) = "F9" _
Or Cells(x, 25) = "Z1" Or Cells(x, 25) = "Z2" Or Cells(x, 25) = "Z3" Or Cells(x, 25) = "Z4" Or Cells(x, 25) = "Z5" Or Cells(x, 25) = "Z6" Or Cells(x, 25) = "Z7" Or Cells(x, 25) = "Z8" Or Cells(x, 25) = "Z9" Then
F1.Cells(x, 25).Copy Destination:=F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

End If
Next x
End Sub

Bonne journée!

Le 03/09/2022 à 11:43

Bonjour Nordik Nation, je te remercie de ta réponse mais je ne sais pas pourquoi, cela ne marche toujours pas...:/

Je pense comprendre ou est le problème.

1-Les matricules commençant par par exemple "A3" ressemble à cela : A383429 ,

(il y a des centaines de matricules) , hors quand je met seulement les deux premiers caractères "A3" dans ma conditions cela ne fonctionne pas, mais cela fonctionne si je met le matricule au complet ( je n'ai pas trop envie de faire une condition avec 1200 matricules dedans aha).

2- comme expliqué précédemment, lorsque je met le matricule au complet, cela fonctionne, hors, mes matricules proviennent d'une recherche V et une fois le copie collé effectué ,dans la sheet2 il m'affiche rechercheV...#REF hors je souhaiterai que cela soit le matricule qui s'affiche. A part cela, le code de Nordik_Nation fonctionne bien§

Si jamais quelqu'un a la réponse cela m'aiderai beaucoup. Je vous remercie.

Le 03/09/2022 à 14:28

Bonjour à tous!

thomas331301,

Ce n'est pas tout à fait de ce que j'avais compris...un essai comme ceci

Option Compare Text
Sub matricule()
Dim F1, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil2")

FinalRow = F1.Cells(Rows.Count, 1).End(xlUp).Row
X = InputBox("Entrez les 2 premiers caractères recherchés")
For i = 2 To FinalRow
If Left(Cells(i, 25), 2) = X Then
F1.Cells(i, 25).Copy Destination:=F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next i
End Sub

ou comme cela

Option Compare Text
Sub matricule()
Dim F1, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil2")

FinalRow = F1.Cells(Rows.Count, 1).End(xlUp).Row
For I = 2 To FinalRow
If Left(Cells(I, 25), 2) = "A1" Or Left(Cells(I, 25), 2) = "A2" Or Left(Cells(I, 25), 2) = "A3" _
Or Left(Cells(I, 25), 2) = "A4" Or Left(Cells(I, 25), 2) = "A5" Or Left(Cells(I, 25), 2) = "A6" _
Or Left(Cells(I, 25), 2) = "A7" Or Left(Cells(I, 25), 2) = "A8" Or Left(Cells(I, 25), 2) = "A9" _
Or Left(Cells(I, 25), 2) = "X1" Or Left(Cells(I, 25), 2) = "X2" Or Left(Cells(I, 25), 2) = "X3" _
Or Left(Cells(I, 25), 2) = "X4" Or Left(Cells(I, 25), 2) = "X5" Or Left(Cells(I, 25), 2) = "X6" _
Or Left(Cells(I, 25), 2) = "X7" Or Left(Cells(I, 25), 2) = "X8" Or Left(Cells(I, 25), 2) = "X9" _
Or Left(Cells(I, 25), 2) = "F1" Or Left(Cells(I, 25), 2) = "F2" Or Left(Cells(I, 25), 2) = "F3" _
Or Left(Cells(I, 25), 2) = "F4" Or Left(Cells(I, 25), 2) = "F5" Or Left(Cells(I, 25), 2) = "F6" _
Or Left(Cells(I, 25), 2) = "F7" Or Left(Cells(I, 25), 2) = "F8" Or Left(Cells(I, 25), 2) = "F9" _
Or Left(Cells(I, 25), 2) = "Z1" Or Left(Cells(I, 25), 2) = "Z2" Or Left(Cells(I, 25), 2) = "Z3" _
Or Left(Cells(I, 25), 2) = "Z4" Or Left(Cells(I, 25), 2) = "Z5" Or Left(Cells(I, 25), 2) = "Z6" _
Or Left(Cells(I, 25), 2) = "Z7" Or Left(Cells(I, 25), 2) = "Z8" Or Left(Cells(I, 25), 2) = "Z9" Then

F1.Cells(I, 25).Copy Destination:=F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next I
End Sub

Bonne journée !

Le 03/09/2022 à 15:38

Bonjour à tous!

thomas331301, une autre manière de faire si la matricule commence par une lettre et est toujours suivie d'un chiffre

Option Compare Text
Sub matricule()
Dim F1, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil2")

FinalRow = F1.Cells(Rows.Count, 1).End(xlUp).Row
For I = 2 To FinalRow
For J = 0 To 9
If Left(Cells(I, 25), 2) = ("A" & J) Or Left(Cells(I, 25), 2) = ("X" & J) _
Or Left(Cells(I, 25), 2) = ("F" & J) Or Left(Cells(I, 25), 2) = ("Z" & J) Then
F1.Cells(I, 25).Copy Destination:=F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next J
Next I
End Sub

Voilà 3 façons de faire en espérant que tu trouveras ton bonheur...

Bonne journée!

Le 09/09/2022 à 10:42

Excuse moi pour ma reponse tardive.

je te remercie énormément Nordine pour ton aide

dernière question , étant donné que ma colonne Y provient d'une recherche V , mon collage en sheet2 m'indique "#REF"

Aurais tu une idée sur la ligne qui permet de copier coller, comme je pourrai faire pour avoir un collage valeur et non un collage simple? (je n'arrive pas a faire de pastespecial , cela m'indique qu'il y a une erreur la compilation est pourtant la bonne)

Au niveau de cette ligne : F1.Cells(I, 25).Copy Destination:=F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

je te remercie!

Le 14/09/2022 à 17:55

Bonjour à tous!

thomas331301, je viens de voir ton message...désolé du retard comme ceci ça devrait réglé ton problème

Option Compare Text
Sub matricule()
Dim F1, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil2")

FinalRow = F1.Cells(Rows.Count, 1).End(xlUp).Row
For I = 2 To FinalRow
For J = 0 To 9
If Left(Cells(I, 25), 2) = ("A" & J) Or Left(Cells(I, 25), 2) = ("X" & J) _
Or Left(Cells(I, 25), 2) = ("F" & J) Or Left(Cells(I, 25), 2) = ("Z" & J) Then
F1.Cells(I, 25).Copy
F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next J
Next I
End Sub

Bonne journée!

Rechercher des sujets similaires à "copier coller condition respectee"