La méthode paste spéciale de la classe range a échouée

Résolu
laurent56380
Messages postés
21
Date d'inscription
vendredi 18 janvier 2008
Statut
Membre
Dernière intervention
27 janvier 2008
- 25 janv. 2008 à 06:29
 bosstony - 21 août 2012 à 17:48
Bonjour,
Ne connaissant pas grand chose en VBA, j'ai essayé de faire une macro comme j'ai pu.
Cette macro recopie une sélection de lignes  dans plusieurs classeurs.
Le problème c'est qu'elle fonctionne pour 1 fichier et qu'elle ouvre bien le 2ème mais ensuite je reçois le message "La méthode paste spéciale de la classe range a échouée".
Que dois-je modifier??
Voici la macro au complet.

Sub Copie_plage()
Dim Fich As String, Ligne As Long
Const Chemin = "D:\ABC\Laurent\Essai macro"


Fich = Dir(Chemin & "\*.xl*")
ThisWorkbook.Sheets("98%").Rows("3770:4000").Select
Selection.Copy
Do While Fich <> ""
Workbooks.Open Filename:=Chemin & Fich
Worksheets("98%").Select
Rows("3770").Select


Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   
Workbooks(Fich).Save
Workbooks(Fich).Close
Fich = Dir
Loop
End Sub

5 réponses

cs_wape
Messages postés
262
Date d'inscription
samedi 21 décembre 2002
Statut
Membre
Dernière intervention
19 décembre 2010
11
25 janv. 2008 à 07:08
Bonjour,

Il faut mettre la copie à l'intérieur de la boucle Do While ... Loop :

Sub Copie_plage()
Dim Fich As String, Ligne As Long
Const Chemin = "D:\ABC\Laurent\Essai macro"


Fich = Dir(Chemin & "\*.xl*")
Do While Fich <> ""
ThisWorkbook.Sheets("98%").Rows("3770:4000").Select
Selection.Copy
Workbooks.Open Filename:=Chemin & Fich
Worksheets("98%").Select
Rows("3770").Select


Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   
Workbooks(Fich).Save
Workbooks(Fich).Close
Fich = Dir
Loop
End Sub

wape
3