Code VBA obsolète Résolu/Fermé

Question

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.

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






Configuration: Windows 7 / Firefox 31.0

pijaku · Answer

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.

pijaku · Answer

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

Code VBA obsolète

2 réponses

Discussions similaires