La méthode paste spéciale de la classe range a échouée [Résolu]

Messages postés
21
Date d'inscription
vendredi 18 janvier 2008
Dernière intervention
27 janvier 2008
- - Dernière réponse :  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
Afficher la suite 

Votre réponse

5 réponses

Meilleure réponse
Messages postés
262
Date d'inscription
samedi 21 décembre 2002
Dernière intervention
19 décembre 2010
3
Merci
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

Merci cs_wape 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 105 internautes ce mois-ci

Commenter la réponse de cs_wape
Messages postés
21
Date d'inscription
vendredi 18 janvier 2008
Dernière intervention
27 janvier 2008
0
Merci
Un Grand Merci.
J'ai essayé, çà marche Nickel.
C'est un plaisir.
Et que de temps gagné.
a+
Laurent
Commenter la réponse de laurent56380
Messages postés
2
Date d'inscription
vendredi 19 décembre 2008
Dernière intervention
10 janvier 2009
0
Merci
Tchoi
Bonjour .
Nouveau sur la liste 
J'ai un problème du même genre que je n'arrive pas à résoudre .
la méthode paste spécial a échoué , bla bla bla ..
les fichiers texte contiennent des nombre décimaux et il ne sont correctement collés avec la virgule que si j'utilise la méthode pas spécial conservation du format et des données .
d'ailleurs je ne comprend pas très bien comment ça marche car manuellement je n'ai pas toujours les mêmes options disponibles dans la boite de dialogues . 
Voici le code

Sub Macro1()
'
' Macro1 Macro

'08-01-2009
Dim fin As Integer
Dim fichier As String
Dim nomfeuil As String
nom_dep = ThisWorkbook.Name

fin = Sheets("fichiers").UsedRange.Rows.Count
For i = 1 To fin
 Sheets("fichiers").Select
fichier = Range("A" & i).Value
MsgBox fichier

dato = Format(Date - 2, "dd-mm-yyyy")
fichier = ActiveWorkbook.Path & "\integre_mails" & fichier & " " & dato & ".txt"
MsgBox fichier

Workbooks.OpenText Filename:= _
     fichier _
        , Origin:=xlMSDOS, StartRow:=11, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), _
        Array(2, 1)), TrailingMinusNumbers:=True
        nomfeuil = ActiveSheet.Name
        MsgBox nomfeuil
        longueur = Sheets(nomfeuil).UsedRange.Rows.Count
    Rows("1:" & longueur).Select
   
   
    Selection.Copy
    ActiveWindow.Close
    Workbooks(nom_dep).Activate
    Sheets("fichiers").Select
    feuille_dest = Range("B" & i)
    Sheets(feuille_dest).Select
    Range("A1").Select
  
  

   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
Next i

End Sub
Commenter la réponse de COLLETF
Messages postés
2
Date d'inscription
vendredi 19 décembre 2008
Dernière intervention
10 janvier 2009
0
Merci
Tchoi
autant pour moi , j'ai trouvé la solution tout seul
j'ai fermé le classeur d'origine des données avant le collage:

    Selection.Copy
    ActiveWindow.Close
si on le ferme après ça marche .
Commenter la réponse de COLLETF
0
Merci
bonjour,

J'ai un problème du meme genre. Mon pasteSpecial me fait un message d'erreur. je cherche à a copier 4 lignes d'un classeur vers un autre classeur. Si je fait le copier coller original selection.paste la copie se fait mais sans les virgules. j'essaie donc de faire le pastespecial pour copier le format mais j'ai l'erreur:

Workbooks.Open Filename:=source
Sheets("Reserves").Select
Rows("281:284").Select
Selection.copy
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Workbooks.Open Filename:=cible
Sheets("Reserves").Select
Rows("281:284").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

ActiveWorkbook.Close


MERCI
Commenter la réponse de bosstony

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.