Sujet Précédent Sujet Suivant

Erreur de Copier coller dans une feuille excel

cs_Elberton Messages postés 25 Date d'inscription mercredi 20 août 2008 Statut Membre Dernière intervention 28 septembre 2019 - 14 févr. 2012 à 11:46
 Utilisateur anonyme - 26 févr. 2012 à 03:28
Bonjour à tous, j'ai un soucis dans une feuille excel.
Ce fichiers comporte plusieurs feuilles. Dans une de ses feuilles, on va chercher des infos à l'aide d'un bouton qui s'appelle Bordereau de vente. Il va chercher toutes les infos dans la feuille déboursé, qui contient diverses données et prix.
Cependant sur un excel 2000 ou office xp cela fonctionne. Mais cela ne fonctionne plus avec un excel 2003 2007 2010.

Cela bloque à partir de ActiveCell.FormulaR1C1 = "'RECAPITULATIF DU BORDEREAU".
j'ai l'erreur suivante : erreur d’exécution 1004. impossible de coller les informations car les zones copié et de collage sont de formes et de taille différentes.

voici la fonction problématique : 

Sub Bordereau_de_vente()
    
    Application.ScreenUpdating = False
    
    'Calcul_de_larrondi
    
    Totaliser_par_chapitre
    
    'Figer les décimales en prévision de l'Euro
    'Dim Message, Titre, Défaut, Lavaleur
    'Message = "Saisissez le nombre de décimales que vous voulez voir apparaître sur le bordereau de vente"
    'Titre = "Nombre de décimales"
    'Défaut = 0
    'Lavaleur = InputBox(Message, Titre, Défaut)
    'Sheets("Feuille de vente").Select
    'Range("D7").Select
    'ActiveCell.Formula = Lavaleur
    'Range("C7").Select
    ' Fin de sous-programme
     
 
    Sheets("Bordereau de vente").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
    
    Sheets("Déboursé").Select
    
    ActiveSheet.Unprotect
    Range("A2").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    
    Sheets("Bordereau de vente").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("B:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("B:D").EntireColumn.AutoFit
    Columns("E:M").Select
    Selection.Delete Shift:=xlToLeft
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Prix" & Chr(10) & "Total"
    With ActiveCell.Characters(Start:=1, Length:=12).Font
        .Name = "Times New Roman"
        .FontStyle = "Normal"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("E2:F2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("F2").Select
    ActiveWindow.DisplayZeros = False

'Saisie de la formule de la vente totale
    Dim Nbl, Lcpt
    
    Selection.CurrentRegion.Select
    Nbl = Selection.Rows.Count - 1
    Lcpt = 1
        
    Range("F3").Select
    
    While Lcpt <= Nbl
        ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
        ActiveCell.Offset(1, 0).Activate
        Lcpt = Lcpt + 1
    Wend
        
    Sheets("Déboursé").Select
    Range("A2").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

    Sheets("Bordereau de vente").Select
    Columns("E:F").Select
    Range("F3").Activate
    Selection.NumberFormat = "#,##0.00 _F"
    Range("A1:B1").Select
    ActiveCell.FormulaR1C1 = _
        "=""CRYSTAL ""&Région&""" & Chr(10) & """&IF(ISBLANK(Entité),"""",Entité)"
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
    With Selection.Font
        .FontStyle = "Gras"
    End With
    Range("C1:F1").Select
    ActiveCell.FormulaR1C1 = "=Désignation&""" & Chr(10) & """&Date_remise"
    Range("C1:F1").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
    With Selection.Font
        .FontStyle = "Gras"
    End With
    Rows("1:1").Select
    Selection.RowHeight = 50
    Cells.Select
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Range("A1:B1").Select
    ColleValeur
    Range("C1:F1").Select
    Application.CutCopyMode = False
    ColleValeur_Annule
    
    Columns("A:F").Select
    Range("A3").Activate
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = ""
    End With
        
    Encadrer_lavente
    
    Derniere_Cellule = Range("F2").End(xlDown).Address
    Range(Derniere_Cellule).Select
    ActiveCell.Offset(1, -5).Range("A1").Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    
    'Préparation de la récapitulation par chapitre
    'coordonnées de la cellule coin haut gauche de la récapitulation
    Coin_hg = ActiveCell.Address
        
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'RECAPITULATIF DU BORDEREAU"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    ActiveCell.Offset(2, -1).Range("A1").Copy

    'récapitulation par chapitre colonne A
    Sheets("Récapitulatif par chapitre").Select
    Derniere_Cellule = Range("A3").End(xlDown).Address
    Range("A3:" & Derniere_Cellule).Select
    Selection.Copy
    Sheets("Bordereau de vente").Select
     Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 1).Range("A1").Copy
    
    
    'récapitulation par chapitre colonne B
    Sheets("Récapitulatif par chapitre").Select
    Derniere_Cellule = Range("C3").End(xlDown).Address
    Derniere_Cellule = "$B$" & Mid(Derniere_Cellule, 4, 5)
    Range("B3:" & Derniere_Cellule).Select
    Selection.Copy
    Sheets("Bordereau de vente").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 4).Range("A1").Copy

    'récapitulation par chapitre colonne H
    Sheets("Récapitulatif par chapitre").Select
    Derniere_Cellule = Range("A3").End(xlDown).Address
    Derniere_Cellule = "$G$" & Mid(Derniere_Cellule, 4, 5)
    Range("G3:" & Derniere_Cellule).Select
    Selection.Copy
    Range("A2").Select 'on repositionne le pointeur en haut à gauche
    Sheets("Bordereau de vente").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    
    Columns("A:F").EntireColumn.AutoFit
    
    Range(Coin_hg).Select
    Selection.RowHeight = 50

    ActiveCell.Offset(2, 0).Range("A1").Select
    Selection.CurrentRegion.Select
    Nb_lignes = Selection.Rows.Count - 1
    Selection.RowHeight = 30
    ActiveCell.Offset(Nb_lignes, 5).Range("A1").Copy
    Coin_bd = ActiveCell.Address   'coin bas droit de la zone

    Range(Coin_hg & ":" & Coin_bd).Select
    Ajoute_bordure
    
    Range(Coin_bd).Select
    ActiveCell.Offset(0, -4).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'MONTANT H.T."
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.ClearContents

    ActiveCell.Offset(1, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=""T.V.A. ""&TVA&"" %"""
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ColleValeur_Annule
    
    ActiveCell.Offset(0, 4).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=ROUND(R[-1]C*RIGHT(RC[-4],6),2)"

    ActiveCell.Offset(1, -4).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'TOTAL T.T.C."
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ActiveCell.Offset(0, 4).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C+R[-1]C"

    Range(Coin_bd).Select
    ActiveCell.Offset(0, -5).Range("A1").Select
    ActiveCell.Range("A1:F1").Select
    Efface_bordure
    ActiveCell.Range("A1:F3").Select
    Ajoute_bordure

    Selection.RowHeight = 40
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ActiveCell.Select
    
    Range("F3").Select
    Selection.ColumnWidth = 25

    Range("A2").Select

End Sub

7 réponses

Réponse 1 / 7
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
14 févr. 2012 à 13:33
Salut,

sans aller plus loin l'erreur est liée au multiple, select, selection, activecell et autre FormulaR1C1 etc.

FormulaR1C1 ou autre formula sont les plus mauvaises méthodes pour attribuer une valeur à une cellule.

Préfère : .value

et comme le pire est toujours possible on trouve même dans ton code : 

ActiveCell.Select 'c'est comme activer la cellule active !!!


Bref supprime tout ce qui ne sert à rien !

quelques exemples: 
    Sheets("Bordereau de vente").Select
    Cells.Select
    Selection.Delete Shift:=xlUp



peut être remplacé par: 
    Sheets("Bordereau de vente").Cells.Delete Shift:=xlUp


************** 

    Range("F2").Select
    ActiveCell.FormulaR1C1 =  "Prix" & Chr(10) & "Total"


doit être remplacé par: 
    Range("F2").Value  = "Prix" & Chr(10) & "Total"


************** 
    Range("E2:F2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With


peut être remplacé par: 

    With Range("E2:F2")
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With


A+
0
Réponse 2 / 7
cs_Elberton Messages postés 25 Date d'inscription mercredi 20 août 2008 Statut Membre Dernière intervention 28 septembre 2019
20 févr. 2012 à 10:08
Bonjour,
J'ai modifié ce qu'il y avait à modifier mais j'ai toujours le problème arrivé ici : 
'récapitulation par chapitre colonne A
    Sheets("Récapitulatif par chapitre").Select
    Derniere_Cellule = Range("A3").End(xlDown).Address
    Range("A3:" & Derniere_Cellule).Copy
    Sheets("Bordereau de vente").Select
     Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 1).Range("A1").Copy

Impossible de faire le collage spécial mouarf.
0
Réponse 3 / 7
mjpmjp Messages postés 115 Date d'inscription dimanche 6 avril 2003 Statut Membre Dernière intervention 29 juin 2012
23 févr. 2012 à 21:24
bonjour
Sheets("Bordereau de vente").Select
Selection.PasteSpecial...
peut etre probleme ici ? manque la cellule de destination ? 
Sheets("Bordereau de vente").Range("A1").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= False, Transpose:=False

@+JP
0
Réponse 4 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
24 févr. 2012 à 07:24
Bonjour, mjpmjp,

J'ai modifié ce qu'il y avait à modifier

Non ! tu n'as fait que corriger les seules lignes dont t'a parlé bigfish, en les remplaçant par ce qu'il t'a montré, mais sans comprendre du tout ce qu'il a pris la peine de t'exposer à propos des select, etc...
Et on voit bien que tu recommences un peu plus loin (les quelques lignes de code que tu viens de nous montrer en sont la preuve la plus criante !

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
24 févr. 2012 à 07:26
Pardon :
Bonjour, mjpmjp, Elberton
Ce qui ne m'empêche par ailleurs pas de dire également bonjour à mjpmjp.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
Réponse 6 / 7
mjpmjp Messages postés 115 Date d'inscription dimanche 6 avril 2003 Statut Membre Dernière intervention 29 juin 2012
24 févr. 2012 à 17:45
bonjour a tous
0
Réponse 7 / 7
Utilisateur anonyme
26 févr. 2012 à 03:28
Bonjour

En plus des judicieux conseils indiqués plus haut. Mets un point d'arrêt (F9) sur la ligne qui sélectionne la plage à copier et vérifie que tu sélectionnes la bonne plage. Mets un autre point d'arrêt sur la ligne qui cause l'horreur. Sauf horreur de ma part, tu devrais être capable de voir si tu copies à la bonne place et si tu colles à la bonne place.

Et puis, de toute évidence ton code sort directement de l'enregistreur de macros. Comme c'est un fidèle perroquet qui ramasse tout. Toutes les propriétés ont une valeur par défaut et très peu, voire aucune, de ces propriétés n'est modifiée.

Cela veut donc dire que tu peux réduire considérablement le nombre de lignes, en ôtant tout ce que toi tu n'as pas choisi fait ou changé en enregistrant ta macro, ou après l'enregistrement.

Attention avec les End.xlup, End.xldown etc... Ce sont des choses très pratiques, mais, il suffit de cliquer, même accidentellement, sur une cellule, même, et surtout, vide pour que la plage soit automatiquement agrandie.
0

Discussions similaires

[vba] recopier la valeur d'une cellule dans une autre feuille.
cokinoumasterflash -
cokinoumasterflash -

5 réponses
Copier coller valeurs d'une feuille vers une autre feuille à partir de la premiè
talined -
ucfoutu -

10 réponses
Vba coller valeur cellule sur une autre cellule avec variable
walyddu59 -
walyddu59 -

3 réponses
copier cellule dans autre feuille (vba)
gnosis35 -
HFanny -

2 réponses
copier le contenu d'une feuille excel dans une autre
xzonz -
aieeeuuuuu -

4 réponses
Rejoignez-nous