Code VBA obsolète
Résolu
massimo888
Messages postés
209
Statut
Membre
-
massimo888 Messages postés 209 Statut Membre -
massimo888 Messages postés 209 Statut Membre -
Bonjour,
J'ai élaboré ce code en vba qui marchait nickel jusqu'à hier soir!
et je ne comprend pas pourquoi il ne marche plus
Pourriez-vous m'aider.
merci.
J'ai élaboré ce code en vba qui marchait nickel jusqu'à hier soir!
et je ne comprend pas pourquoi il ne marche plus
Pourriez-vous m'aider.
merci.
Sub Recherche_Chaine()
Sheets("A").Activate
Dim Nb_Ligne As Integer, i As Integer
Nb_Ligne = Cells(Rows.Count, 1).End(xlUp).Row
Mot_Recherche = "oui"
'Recerche du mot oui dans la colonne A
For i = 1 To Nb_Ligne
Resultat = InStr(Cells(i, 1), Mot_Recherche)
If Resultat <> 0 Then
'MsgBox ("Le mot a été trouvé en Ligne " & i)
Range(Cells(i, 1), Cells(i, 34)).Select
With Selection
.Copy
Sheets("B").Select
Sheets("B").Select
[A65536].End(xlUp).Select
Selection.EntireRow.Insert
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Sheets("A").Activate
End If
Next i
Sheets("B").Activate
'Supression des doublons
Range("Tableau2").Select
ActiveSheet.Range("Tableau2").RemoveDuplicates Columns:=Array(1, 2, 3, 4, _
5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, _
33, 34), Header:=xlYes
End Sub
2 réponses
-
Bonjour,
Dire « Ça ne marche pas » ou « Il y a une erreur », cela n'avance en rien.
Donnez le comportement observé et/ou le message d'erreur !
De plus, lorsque vous placez du code sur notre forum, merci d'utiliser les balises code à votre disposition.
Le mode d'emploi (au cas ou) est ICI.
-
Merci je suis désolé je suis adepte du forum depuis peu!
par contre le bug se fait au niveau de la partie collage
c'est au niveau de cette partie ou ça bloque ça me colle rien et il me met "méthode pastspecial a échoué'
sub
Selection.EntireRow.Insert
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False -
-
-
Bon.
Essaye de remplacer :If Resultat <> 0 Then 'MsgBox ("Le mot a été trouvé en Ligne " & i) Range(Cells(i, 1), Cells(i, 34)).Select With Selection .Copy Sheets("B").Select Sheets("B").Select [A65536].End(xlUp).Select Selection.EntireRow.Insert Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With Sheets("A").Activate End If
par :
If Resultat <> 0 Then 'MsgBox ("Le mot a été trouvé en Ligne " & i) Range(Cells(i, 1), Cells(i, 34)).Copy With Sheets("B").Range("A65536").End(xlUp).Offset(1, 0) .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With End If
