Préserver le contenu du clipboard en effaçant une cellule [Résolu]

[shimuno]

Bonjour,

Je souhaiterais créer une macro qui efface les données d'une page puis colle de nouvelles données. Mais j'ai l'impression que l'effacement des données existantes supprime du même coup le contenu du presse papier. Du coup, il faut que l'utilisateur efface les données, copie les nouvelles et utilise la macro pour les coller.

Une idée pour effacer puis coller de nouvelles données en un clic ?

Bonne journée à tous.

[patricktoulon]

bonjour

j'ai beau essayer de deviner mais milles excuse avec les quelques neurones qu'il me reste je n'arrive pas a saisir ce que tu veux

pourrais tu t'expliquer voir même un peu de code serait le bien venu

tu copie quoi,ou, comment ???


au plaisir

[shimuno]

Bonjour Patrick,

Désolé pour cette réponse tardive, quelques contretemps persos...

Pour l'instant, j'ai deux macros. La première efface les données existantes :

Code :

Sheets("Arrow").Rows("2:36000").Delete Shift:=xlUp

La seconde colle une plage de cellules qu'un utilisateur a copié manuellement.

Code :

1
2
[a5].PasteSpecial Paste:=xlPasteValues
[a5].PasteSpecial Paste:=xlPasteFormats

J'aimerais si possible n'avoir qu'une seule macro, qui efface puis colle. Problème : quand Excel efface il "perd" le contenu du presse papier, donc impossible de coller.

J'espère que c'est un peu plus clair...

Merci beaucoup pour ton aide.

[jfontaine]

Bonjour,

Une solution sans utiliser le presse papier

Code :

1
2
3
4
5
6
7
8
 
Dim rg As Range
Set rg = Selection
 
 
Cells.Delete xlUp
 
Range("A1").Resize(rg.Count, rg.Columns).Value = rg.Value

[shimuno]

Merci pour ta réponse.

Sur tes conseils, j'ai écris ça :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Delete_Paste_Arrow()
 
Application.ScreenUpdating = False
 
'Affecter les données copiées à une variable
 
Dim rg As Range
Set rg = Selection
 
'Effacer les données existantes
 
Sheets("Arrow").Rows("2:36000").Delete Shift:=xlUp
 
'Coller après avoir désactivé l'affichage
 
Range("A5").Resize(rg.Count, rg.Columns).Value = rg.Value
 
Exit Sub

Et il bloque sur Range("A5").Resize(rg.Count, rg.Columns).Value = rg.Value en me mettant 'Objet requis'.

Petite précision : l'utilisateur du fichier doit pouvoir copier des données venant d'un autre classeur et récupérer la mise en forme (on vient de me le demander).

Des idées ?

[jfontaine]

Petite précision : l'utilisateur du fichier doit pouvoir copier des données venant d'un autre classeur et récupérer la mise en forme (on vient de me le demander).

dans ce cas, ma proposition ne conviendra pas. Il faudra passer par le copier/coller.
Peut être pourrais tu ajouter un onglet, coller les données, supprimer l'ancien onglet et renommer le nouveau !

[shimuno]

Très bonne idée, qui marche parfaitement. Pour ceux que ça intéresse, voici le code.

Code :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub Delete_Paste_Arrow()
 
'Cette macro permet de coller les données d'Arrow après les avoir copiées manuellement.
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'En cas d'erreur, aller à ErrorHandler
 
On Error GoTo ErrorHandler
 
'Créer la feuille temporaire
 
Sheets.Add.Name = "TempArrow"
 
'Coller les données sur la feuille temporaire
 
Sheets("TempArrow").Select
 
[a5].PasteSpecial Paste:=xlPasteValues
[a5].PasteSpecial Paste:=xlPasteFormats
 
'Effacer les données existantes de la feuille Arrow
 
Sheets("Arrow").Rows("2:36000").Delete Shift:=xlUp
 
'Copier les données de TempArrow
 
With Sheets("TempArrow")
        .Range(.Cells(5, 1), .Cells(10000, 50)).Copy Sheets("Arrow").Cells(5, 1)
End With
 
'Effacer la feuille TempArrow
 
Sheets("TempArrow").Delete
 
'Régler les couleurs
 
Palette
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
Exit Sub
 
'En cas d'erreur, afficher l'instruction
 
ErrorHandler:
MsgBox "Please select a range of cell on an Arrow Excel file. You cannot select entire lines or columns." & Chr(13) & Chr(13) & "                                 Please delete pre existing Arrow data if necessary.", vbOKOnly
 
'Supprimer TempArrow
 
Dim Ws As Worksheet
 
On Error Resume Next
Set Ws = ThisWorkbook.Worksheets("TempArrow")
On Error GoTo 0
 
If Ws Is Nothing Then
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
 
Else
Sheets("TempArrow").Delete
 
End If
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub