macro vba débutant copier coller format et texte plusieur feuilles

G

Guest

Invité
bonjours je viens vair vous pour améliorer ma macro elle fonctionne très bien mais je voudrais que la macro ce lance a la moindre modification d'une des cases sélectionnées et ne pas être obliger d'entrer dans une case pour la lancer voici ma chose :)


Sub copies()

Range("A1: D33").Select
Range("a1: D33").Activate

Selection.Copy
Sheets("florian ").Select
Range("A1: D33").Select
Range("a1").Activate

Sheets(Array("Florian ", "Jean Marc", "Philippe ", "Francis", "Nicolas", _
" sans les heures tec th", "yoan", "dorian", "kurdy", "chetritt", "pierre", _
"Richard ", "Bruno ", "Patrick ", "mily picart", "virgile", " sans les heures tec EU", _
"Nicole ", "Isabelle ", "Babeth ", "Nathalie", "Dorine", "Géraldine", "Annie Saldana", "admin th ss les heures")).Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("planing gen").Select
Sheets("planing gen").Activate

End Sub

votre avis m’intéresse :d
et si le code est simplifiable je prend aussi
 

zeb

Modérateur
:pfff:

Salut,

Relis 90% de mes messages. Je m'y bagarre contre l'utilisation du presse-papier comme zone de mémoire tampon d'une part et contre l'utilisation abusive des Select/Selection et autre Truc.Activate/ActiveTruc.

Du coup, oui, le code est simplifiable et fiabilisable surtout.
 

drul

Obscur pro du hardware
Staff
Pour l'excution automatique: (source aide VBA)

SheetChange Event
See Also Applies To Example

Occurs when cells in any worksheet are changed by the user or by an external link.

Private Sub object_SheetChange(ByVal Sh As Object, ByVal Source As Range)
object Application or Workbook. For more information about using events with the Application object, see Using Events with the Application Object.

Sh A Worksheet object that represents the sheet.

Source The changed range.

Remarks
This event doesn't occur on chart sheets.

Example
This example runs when any worksheet is changed.

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Source As Range)
' runs when a sheet is changed
End Sub

 

zeb

Modérateur
Dis, tu veux mettre ton message en conformité avec les règles du site ?
Utilise pour ça la balise [code=VB][/code] pour présenter ton code

Ça vaut pour BrAnke et pour drul !
[:zeb:4]
(Ben alors drul !?)
 

drul

Obscur pro du hardware
Staff
C'est pas du code, c'est l'aide VBA ... (sinon je met toujours les balises promis zeb)
 

BrAnKe

Nouveau membre
je n'arrive pas à modifier mon message d'origine je n’était pas inscrit a l’époque et je ne trouve pas pour ce message l’icône magique :/

voila après un long moment de recherche et de tentative infructueuse je crois avoir trouver ça fais des lignes et des ligne mais bon
j'ai d abord essayé de mettre une variable commune pour les destinations mais pas possibles j'ai pas trouver

voili voilou

Code:
Sub copie()

Dim ws_source As Worksheet

Set ws_source = Worksheets("planing gen")

ws_source.Range("a1:d33").Copy Destination:=Worksheets("florian ").Range("a1:d33")

ws_source.Range("a1:d33").Copy Destination:=Worksheets("Jean Marc").Range("a1:d33")

ws_source.Range("a1:d33").Copy Destination:=Worksheets("Philippe  ").Range("a1:d33")

ws_source.Range("a1:d33").Copy Destination:=Worksheets("Francis").Range("a1:d33")

ws_source.Range("a1:d33").Copy Destination:=Worksheets("Nicolas").Range("a1:d33")

ws_source.Range("a1:d33").Copy Destination:=Worksheets(" sans les heures tec th").Range("a1:d33")

ws_source.Range("a1:d33").Copy Destination:=Worksheets("yoan").Range("a1:d33")

etc....

pour l'éxécution automatique j'ai trouver ca
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
     If Not Intersect(Target, [A1:D33]) Is Nothing Then
     
  Call copie
  
         
     End If
End Sub
que j'ai placer dans le document source

une autre question car évidament mon directeur technique (je suis éclairagiste) me demande si on peut faire évoluer ca pour que la copie se fasse a partir d'un autre document
alors la j'ai un problemme de séléction de document si on peut m'éxpliquer merci voici la partie qui bloque


Code:
Dim wb_source As Workbook
Dim wb_target As Workbook
 
Set wb_source = Workbooks("T:\COMMUN ADM\PLANNING GENERAL\Planning Général 2012~2013.xls")
Set wb_target = Workbooks("T:\COMMUN ADM\PLANNING PERSONNELS\PREVISIONNELS HEURES PERSONNELS\2012\08 aout 2012.xls")
la ligne 4 me dis "l'indice n'apartient pas a la sélection" a savoir que c est le document ou a lieu la macro et qui doit être modifier ????
je suis pas programmateur et je suis long a la comprenette sur ce coup.




 

zeb

Modérateur
Salut,

Alors non, tu n'es pas programmateur, je sais.

Ceci est un programmateur :
Vous devez être connecté pour voir les images.

------------------

Si tu es long à la comprenette parce que tu n'es pas programmeur, mais que tu es quand même de bonne volonté, on va t'aider quand même. ;)
Par contre, tu aurais pu le dire plus tôt. Spa grave.

Sauf que le type qui vient pour dire "ça marche, mais comment faire encore mieux ?", il n'est pas d'office catégorisé comme béotien.

------------------

Bon, alors en programmation, moins on en écrit, mieux c'est :)
Regarde :
Code:
Dim sh_name As Variant ' // Array(..) n'accepte que ça :(
For Each sh_name In Array("Eva", "François", "Jacques", "Jean-Luc", "Marine", "Nathalie", "Nicolas", "Philippe")
    ws_source.Range("A1:D33").Copy Worksheets(sh_name).Range("A1")
Next

Ici, on donne la liste de toutes les feuilles qu'on veut charger.
On peut aussi faire le contraire. Donner les feuilles qu'on ne veut pas écraser.

Exemple avec une seule feuille, la feuille source :
Code:
Dim ws As Worksheet
For Each ws In Worksheets
    If not (ws Is ws_source) Then ws_source.Range("A1:D33").Copy ws.Range("A1")
Next

A voir donc avec ton cas particulier.

Code:
Set wb_source = Workbooks("T:\COMMUN ADM\PLANNING GENERAL\Planning Général 2012~2013.xls")
Set wb_target = Workbooks("T:\COMMUN ADM\PLANNING PERSONNELS\PREVISIONNELS HEURES PERSONNELS\2012\08 aout 2012.xls")
Ça ne marche pas comme ça. Enfin, pas tout à fait.
Soit ton classeur est déjà ouvert, soit il faut encore l'ouvrir.

Un truc sympa, c'est de mettre la macro dans le code d'un classeur particulier.
Dans ton cas, il serait bien dans la source. Non ?
Si c'est le cas, alors définir la source dans le code de la source est facile :
Code:
Set wb_source = ThisWorkbooks

Pour désigner un classeur cible, soit il est déjà ouvert et il faut le référencer par son nom sans le chemin, soit l'ouvrir par macro.
Code:
' Déjà ouvert
Set wb_source = Workbooks("Planning Général 2012~2013.xls")

' Ouverture
Set wb_target = Workbooks.Open("T:\COMMUN ADM\PLANNING PERSONNELS\PREVISIONNELS HEURES PERSONNELS\2012\08 aout 2012.xls")

Après tout ça, il reste à savoir si tu te trouves dans les cas exposés.
 

BrAnKe

Nouveau membre
bon résumons
le classeur cible je l'ouvre grasse a la macro pour copié dedans ça ok
le classeur "émetteur" il est déjà ouvert vue que les gens le modifie
l'identification ça marche j'ai compris pour les classeurs


ensuite
Code:
For Each sh_name In Array("Eva", "François", "Jacques", "Jean-Luc", "Marine", "Nathalie", "Nicolas", "Philippe")

tu m'arrette si je me trompe j'essaye de traduire ca
en gros tu nomme toutes les feuille qu'on veut uttiliser sh_name et tu demande de répéter une opération sur toute ces feuille

Code:
ws_source.Range("A1:D33").Copy Worksheets(sh_name).Range("A1")
et ca ces ta copie sans presse papier

voila mon code repris a zero
Code:
Option Explicit

Private Sub CommandButton1_Click()
            

'séléction

Dim x As Shape

Dim wb_target As Workbook
Dim wb_source As Workbook
Dim ws_source As Worksheet


Set wb_source = Workbooks("Planning Général.xls")
Set wb_target = Workbooks.Open("T:blabla/bla/bllaaaa.xls")
Dim sh_name As Variant
'boucle
For Each sh_name In Array("Florian ", "Jean Marc", "Philippe  ", "Francis", "Nicolas", _
        " sans les heures tec th", "yoan", "dorian", "kurdy", "chetritt", "pierre", _
        "Richard  ", "Bruno ", "Patrick ", "mily picart", "virgile", " sans les heures tec EU", _
        "Nicole ", "Isabelle  ", "Babeth  ", "Nathalie", "Dorine", "Géraldine", "Annie Saldana", "admin th ss les heures")
 
 'effacement zone texte si présente
 
 wb_target.Worksheets(sh_name).Select
 If ActiveSheet.Shapes.SelectAll Then
 Selection.Delete
 End If
'copie
  Range("A1:D33").Copy Destination:=wb_target.Worksheets(sh_name).Range("A1:D33")
  
  Next
'fin boucle

'sauvegarde et férmeture
wb_target.Save
wb_target.Close

End Sub

je crois j'ai tous bon j ai plus qu'adapter le code pour chaque feuille de mois
option explicite ça sert a quoi ?
au je vais chercher finirais par comprendre

sinon encore mercis
si tu veut bien posée la balise résolu pour moi j yarrive pas avec cette histoire de guest
 

zeb

Modérateur
Salut,

Ben oui, t'as tout compris.
;)

Si la macro est dans le classeur "Planning Général~2013", n'hésite pas à utiliser ThisWorkbook pour le désigner dans ses macros.

Le fait de mettre une destination à la méthode Copy permet de ne pas passer par le presse-papier. Va lire l'aide (RTFM) d'Excel/VBA sur cette méthode.

A la ligne 20, tu copies un Range sans préciser ni sa feuille, ni son classeur. C'est mal.

Et arrête de mettre l'adresse de tes cellules en minuscule, c'est agaçant. :fou: :fou: :fou:
En vrai, on s'en fout. :o

Tes problèmes de cadres peuvent avoir plusieurs solutions.
L'une d'elles est radicale : on supprime la feuille et on en recrée une.

Sinon, on peut rechercher ces cadres et les supprimer.
Au fait, qu'est-ce que tu appelles un cadre ?
 

BrAnKe

Nouveau membre
bon voila mes corrections
appellation

Code:
'séléction

Dim x As Shape

Dim wb_target As Workbook
Dim wb_source As Workbook
Dim ws_source As Worksheet
Set ws_source = Worksheets("nom de ma feuille source")
Set wb_source = ThisWorkbook
Set wb_target = Workbooks.Open("chemin dossier cible")
Dim sh_name As Variant
jusqu'ici ça devrait vous plaire (j’espère)

on boucle
et j'efface mes cadre qui sont des zone de texte je crois avoir trouver la bonne méthode pour que ça ne m'efface pas tout quand il n'y a pas de zone de texte dans le documents source (1 fois sur 2)

Code:
'boucle
For Each sh_name In Array("Florian ", "Jean Marc", "Philippe  ", "Francis", "Nicolas", _
        " sans les heures tec th", "yoan", "dorian", "kurdy", "chetritt", "pierre", _
        "Richard  ", "Bruno ", "Patrick ", "mily picart", "virgile", " sans les heures tec EU", _
        "Nicole ", "Isabelle  ", "Babeth  ", "Nathalie", "Dorine", "Géraldine", "Annie Saldana", "admin th ss les heures")
 
 'effacement zone texte
 
wb_target.Worksheets(sh_name).Select

For Each x In ActiveSheet.Shapes
If Left(x.Name, 4) = "Text" Then

x.Delete

End If
Next x


'copie
ws_source.Range("A1:D33").Copy Destination:=wb_target.Worksheets(sh_name).Range("A1:D33")
  
  Next sh_name
'fin boucle
et enfin on sauvegarde et on ferme le dossier cible
Code:
wb_target.Save
wb_target.Close

End Sub

je crois avoir pris note de tes remarques en espérant que ce code vous semble propre et stable

mercie
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 134
Messages
6 718 080
Membres
1 586 395
Dernier membre
franckorus
Partager cette page
Haut