Copier les cellules commencant par MIRE

[bibbip35]

Bonjour à tous

Je suis en train de réaliser une macro qui me permettrai de copier les cellules commençant par "MIRE"
mais j'ai toujours une erreur
"la méthode range de l'objet _global a échoué"

Objectif :
Copier les cellules commençant par MIRE de la feuille1 ( ColD ) vers feuil EXPORT ( ColE)
Puis copier les cellules correspondante aux cellule trouver en col C & col D de la feuil EXPORT

J'ai mis en PJ le fichier avec exemple de ce que je souhaiterai obtenir
et avec la macro me provoquant des pb

Sub Macro1()
'
' Macro1 Macro
'

Dim i As Integer
Dim XTopo
Dim XPartnumber
Dim XX

Worksheets("EXPORT").Range("A1:H65000").ClearContents



Worksheets("Feuil1").Select

For i = 1 To Worksheets("Feuil1").Range("D65530").End(xlUp).Row
If Range("D" & i) Like "MIRE*" Then


Sheets("Feuil1").Activate
Worksheets("Feuil1").Select
Range(Range("D" & i).Offset(, 0)).Copy
Worksheets("EXPORT").Select
Range("E65530").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else

End If
Next i


Pouvez-vous m'aider?

Merci a tous

Bibbip35

End Sub

 

[youky(BJ)]

Re : Copier les cellules commencant par MIRE

Bonsoir bibbip,
Essaies ceci.....
Bruno

Sub Macro1()
 Dim i As Integer
 Dim XTopo
 Dim XPartnumber
 Dim XX
Worksheets("EXPORT").Range("A1:H65000").ClearContents
Worksheets("Feuil1").Select
 For i = 1 To Worksheets("Feuil1").Range("D65530").End(xlUp).Row
      If Range("D" & i) Like "MIRE*" Then
          Range("D" & i).Offset(, 0).Copy
         Worksheets("EXPORT").Select
         Range("E65530").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         Else
    End If
 Next i
 End Sub

 

[sousou]

Re : Copier les cellules commencant par MIRE

Bonsoir
Plusieurs erreurs dans ton code,
1/ range(range.....
2/ Ne pas utiliser les méthodes select et activate
la manière dont tu utilises range s'effectue sur la feuille à ce moment active et les erreurs peuvent nombreuses et destructives
Il faut mieux utiliser l'adressage direct sans visualiser les feuilles
essai avec ce code, et regarde le with end with
Sub Macro1()
'
' Macro1 Macro
'

Dim i As Integer
Dim XTopo
Dim XPartnumber
Dim XX

Worksheets("EXPORT").Range("A1:H65000").ClearContents



With Worksheets("Feuil1")

For i = 1 To .Range("D65530").End(xlUp).Row
If .Range("D" & i) Like "MIRE*" Then
.Range("D" & i).Offset(0, 0).Copy
Worksheets("EXPORT").Range("E65530").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else

End If
Next i

End With
End Sub