macro

C

cyril

Guest
Bonsoir (ou bonjour ?) tous le monde,
Je reviens à la charge avec ma macro qui doit me permettre de me faciliter la vie en copiant rapidement mes saisies d'un onglet à un autre. Malgrè les conseils que vous m'avez donnés hier, ça ne fonctionne pas, à chaque fois que j'active la macro j'ai toujours les informations de la ligne initiale qui apparaissent. Afin de mieux me faire comprendre, je vous transmet mon ficher avec aussi le détail de la macro (j'ai modifié les informations sur mon fichier car il s'agit d'infos confidentielles).
Merci et désolé de vous embêter avec mes petits problèmes.
Bonne soirée (ou bonne journée).
A+ tout le blonde,
Cyril
Sub TELEPHONE()
'
' TELEPHONE Macro
' Macro enregistrée le 15/04/03 par CYRIL
'

'
Range("A2").Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E8").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B12").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B16").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
ActiveWindow.SmallScroll Down:=8
Range("B22").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("LUNDI").Select
ActiveWindow.SmallScroll ToRight:=3
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E10").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
 

Pièces jointes

  • PHONES16.xls
    49.5 KB · Affichages: 49
Trier par date Trier par votes
M

Mytå

Guest
Bonsoir Cyril

Voila ta macro un peut trafiquer qui copie la cellule A2, A3 ,... selectionner dans tom message papier

Sub TELEPHONE()
'
' TELEPHONE Macro
' Macro enregistrée le 15/04/03 par CYRIL
'

feuille = ActiveSheet.Name
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E8").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B12").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B16").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("B22").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets(feuille).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 3).Select
Selection.Copy
Sheets("MESSAGE PAPIER").Select
Range("E10").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End Sub

A voir si cela te convient

Mytå
 
Vote positif 0 Vote négatif
M

Mytå

Guest
re Cyril

J'ai simplifier ta macro a ceci

verification de feuille bien lundi, mardi ou mercredi et la colonne 1 selectionner cela donne

Sub telephone2()
feuille = ActiveSheet.Name
If feuille <> "LUNDI" And feuille <> "MARDI" And feuille <> "MERCREDI" Then Exit Sub
If ActiveCell.Column <> 1 Then Exit Sub
Dim dest(8)
dest(1) = "E6": dest(2) = "E7": dest(3) = "E8": dest(4) = "B12"
dest(5) = "B14": dest(6) = "B16": dest(7) = "B22": dest(8) = "E10"
i = 1
a = ActiveCell.Row
For Each valeur In Range("A" & a & ",B" & a & ",C" & a & ",D" & a & ",E" & a & ",F" & a & ",G" & a & ",J" & a)
valeur.Copy
Sheets("MESSAGE PAPIER").Select
Range(dest(i)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets(feuille).Select
Application.CutCopyMode = False
i = i + 1
Next valeur
Sheets(feuille).Range("A1").Activate
End Sub
 
Vote positif 0 Vote négatif
M

Mytå

Guest
oups pas signer :)))


smiley_417.gif


P.S. Prière d'accuser réception si cela te convient
ou ne convient pas en répondant sur ce Post ... Merci !
 
Vote positif 0 Vote négatif
Z

Zon

Guest
Bonsoir à tous,

Cyril, moi je te propose un code un peu plus général, c'est à dire que quelque soit la cellule sélectionnée dans la colonne A pour les feuilles LUNDI, MARDI, MERCREDI (Jeudi...) elles seront collées dans la feuille Message papier.



Sub TELEPHONE()
'
' TELEPHONE Macro
' Macro enregistrée le 15/04/03 par CYRIL
'

Dim ws, ws1 As Worksheet
Dim L As Integer
Set ws = Sheets("MESSAGE PAPIER")
Set ws1 = ActiveSheet

Application.ScreenUpdating = False

ws1.Activate
'copie des 3 premieres cellules
ws1.Range(ActiveCell, ActiveCell.Offset(0, 2)).Copy
ws.Range("E6").PasteSpecial xlValues, Transpose:=True

'copie de la raison sociale
ws1.Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 3)).Copy
ws.Range("B12").PasteSpecial xlValues

'copie interlocuteur
ws1.Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 4)).Copy
ws.Range("B14").PasteSpecial xlValues

'copie du téléphone
ws1.Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(0, 5)).Copy
ws.Range("B16").PasteSpecial xlValues

'copie de l'objet
ws1.Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 6)).Copy
ws.Range("B22").PasteSpecial xlValues

'copie de CSV
ws1.Range(ActiveCell.Offset(0, 7), ActiveCell.Offset(0, 7)).Copy
ws.Range("E10").PasteSpecial xlValues

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


A+++
 
Vote positif 0 Vote négatif
Z

Zon

Guest
Re

Mytâ je n'avais pas vu ton dernier code avnt de poster ma réponse et je te dis bravo, moi je n'avais pas pensé à mettre les cellules destination dans un tableau et à tester la colonne de la cellule active...



A++
 
Vote positif 0 Vote négatif
Z

Zon

Guest
RE,

Le tetris me fatigue, j'aurais dû être plus attentif à mon code qu'aux briques.

Par contre je ne comprends pas pour le message va être "Message Papier va être drôle à lire" ? puisque les trois feuilles jours LUNDI ... ont la même présentation...


A+++
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
281
robpellan52
R
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
342
gwenn49
G
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
124
Francky79
F
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
461
olivier388
O
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
376
fanou06
F
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
613
TooFatBoy
TooFatBoy
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
316
Usine à gaz
Usine à gaz
M
  • Question
Microsoft 365 Erreur de format
Réponses
5
Affichages
135
Marvin57
M
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
535
mouchtre
mouchtre

Membres actuellement en ligne

15 membres et 103 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 321
Messages
2 087 237
Membres
103 497
dernier inscrit
JP9231