Vba

Fermé
al1212 Messages postés 3 Date d'inscription mercredi 27 mai 2015 Statut Membre Dernière intervention 28 mai 2015 - 27 mai 2015 à 19:24
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 - 29 mai 2015 à 19:06
Bonjour a toutes et tous.
Mon pb est le suivant j ai plusieurs classeurs excell. j ai besoin d une macro et je suis archi nul;
A partir d un fichier je voudrais copier une cellule ( par ex A,50)dans tout mes autres classeurs.Quelqu' un pourrai m aider?
Merci

4 réponses

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
27 mai 2015 à 22:34
Bonsoir Al, bonsoir le forum,

Comment t'aider avec une question aussi vague ?!
  • A50 de quel onglet du classeur source veut-tu copier ?
  • Tous mes autres classeurs ? trop vague !...

- Dans quel dossier se trouvent-ils ?
- Qu'ont-ils en commun ?
- Quelle l'extension ?
  • On colle dans quel onglet du classeur destination ?


Fait un effort pour fournir des explication précises et je suis sûr que tu obtiendras rapidement des réponses.
0
al1212 Messages postés 3 Date d'inscription mercredi 27 mai 2015 Statut Membre Dernière intervention 28 mai 2015
28 mai 2015 à 04:10
Bonjour ThauTheme
Je détaille :
2000 classeurs dans un meme répertoire appelé TEST.Les classeurs sont identiques à l exception de quelques valeurs a chaque fois(copier coller de l un a l autre puis modif de quelques valeurs.)
A modifier dans tout les classeurs feuille 1 cellule a;50
à partir d un classeur source appelé MACRO feuille 1 ,cellule a;50 avec un contenu texte par exemple :coucou
extension des classeurs .xls
Merci d avace pour vos réponses.
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
28 mai 2015 à 11:29
Bonjour Al, bonjour le forum,
Si le classeur source se trouve dans le même dossier (TEST) que les autres classeurs, essaie le code ci-dessous à placer dans le classeur source :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim FS As String 'déclare la variable FS (FichierS)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source CS [peut-être remplacé par : Set OS = CS.Sheets("Feuil1")]
CA = CS.Path 'définit le chemin d'accès CA
FS = Dir(CA & "\*.xls") 'définit l'ensemble des fichiers Excel FS du dossier ayant CA comme chemin d'accès
Do While FS <> "" 'éxécute tant qu'il existe des fichiers
    If FS <> CS.Name Then 'confition : si le nom du fichier est différent du nom de classeur source CS
        Application.Workbooks.Open (FS) 'ouvre le fichier FS
        Set CD = ActiveWorkbook 'définit le classeur destination CD
        Set OD = CD.Sheets(1) 'définit l'onglet destination CD [peut-être remplacé par : Set OD = CD.Sheets("Feuil1")]
        'récupère la valeur de la cellule A50 [peut-être remplacé par OS.Range("A50").Copy OD.Range("A50") si tu veux aussi le format]
        OD.Range("A50").Value = OS.Range("A50").Value
        CD.Close SaveChanges:=True 'ferme le classeur destination en renregistrant les changements
    End If 'fin de la condition
    FS = Dir 'redéfinit la variable FS (fichier suivant)
Loop 'boucle
MsgBox "Copie terminée !" 'message
End Sub


Sinon, essaie cet autre code, toujours à placer dans le classeur source mais auparavant, pense à adapter à ton cas la ligne 11 qui définit le chemin d'accès :

Sub Macro2()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim FS As String 'déclare la variable FS (FichierS)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source CS [peut-être remplacé par : Set OS = CS.Sheets("Feuil1")]
CA = "C:\Users\Al\Desktop\TEST" 'définit le chemin d'acces CA (à adapter à ton cas)
FS = Dir(CA & "\*.xls") 'définit l'ensemble des fichiers Excel FS du dossier ayant CA comme chemin d'accès
Do While FS <> "" 'éxécute tant qu'il existe des fichiers
    If FS <> CS.Name Then 'confition : si le nom du fichier est différent du nom de classeur source CS
        Application.Workbooks.Open (FS) 'ouvre le fichier FS
        Set CD = ActiveWorkbook 'définit le classeur destination CD
        Set OD = CD.Sheets(1) 'définit l'onglet destination CD [peut-être remplacé par : Set OD = CD.Sheets("Feuil1")]
        'récupère la valeur de la cellule A50 [peut-être remplacé par OS.Range("A50").Copy OD.Range("A50") si tu veux aussi le format]
        OD.Range("A50").Value = OS.Range("A50").Value
        CD.Close SaveChanges:=True 'ferme le classeur destination en renregistrant les changements
    End If 'fin de la condition
    FS = Dir 'redéfinit la variable FS (fichier suivant)
Loop 'boucle
MsgBox "Copie terminée !" 'message
End Sub


Si tu as 2000 classeurs cette macro va mettre pas mal de temps... C'est pour cela que j'ai rajouté un message pour te dire que c'était (enfin) fini.
0
al1212 Messages postés 3 Date d'inscription mercredi 27 mai 2015 Statut Membre Dernière intervention 28 mai 2015
Modifié par pijaku le 29/05/2015 à 10:34
Soit ca marche pas soit je suis nul!!! Je suis sur d etre nul.!!Jai trouvé une macro qui fait une boucle pour enlever les protections de fichiers et quand je la copie et l execute tout mes classeurs sont déprotégés.
Ne serait il pas possible de recuperer la partie boucle et d y inserer la tache à accomplir?a savoir la copie de la cellule A50 feuille 1 du fichier source sur le meme emplacement des autres classeurs a50 feuille1
Voici la macro
Sub Déprotége_Fichiers() 
    Dim Chemin As String, Fichier As String 
    Dim Feuille As Worksheet 
    Chemin = ThisWorkbook.Path & "\" 
    Fichier = Dir(Chemin & "*.xls") 
    'boucle sur tous les classeurs 
    Do While Len(Fichier) > 0 
        If Fichier <> ThisWorkbook.Name Then 
            'ouvre le fichier 
            Workbooks.Open Filename:=Chemin & Fichier 
            'boucle sur chaque feuille 
            For Each Feuille In ActiveWorkbook.Worksheets 
                'déprotège 
                Feuille.Unprotect 
            Next 
            ActiveWorkbook.Save 
            ActiveWorkbook.Close 
        End If 
        Fichier = Dir() 
    Loop 
End Sub

Pour tes deux macros ThauTheme erreur 1004 ou alors copie réussie mais uniquement dans le fichier source???


A l aide
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
29 mai 2015 à 19:06
Bonsoir Al,

À aucun moment tu navet (si, si, dans ce cas on peut) précisé que les onglet était protégés !...

Erreur 1004 ok, mais où ? Dans quelle ligne du code. Chez moi ça ne plante pas donc si tu ne fais pas l'effort d'être clair dans l'énoncé du problème il nous sera difficile de t'aider davantage.

Ta macro ressemble tellement à la mienne que je me demande si ce n'est pas son frère jumal ?...

Voici un mix des deux codes avec => Ouverture / Déprotection / Copie / re Protection / Fermeture avec Sauvegarde :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim FS As String 'déclare la variable FS (FichierS)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source CS [peut-être remplacé par : Set OS = CS.Sheets("Feuil1")]
CA = CS.Path 'définit le chemin d'accès CA
FS = Dir(CA & "\*.xls") 'définit l'ensemble des fichiers Excel FS du dossier ayant CA comme chemin d'accès
Do While FS <> "" 'éxécute tant qu'il existe des fichiers
    If FS <> CS.Name Then 'confition : si le nom du fichier est différent du nom de classeur source CS
        Application.Workbooks.Open (FS) 'ouvre le fichier FS
        Set CD = ActiveWorkbook 'définit le classeur destination CD
        Set OD = CD.Sheets(1) 'définit l'onglet destination CD [peut-être remplacé par : Set OD = CD.Sheets("Feuil1")]
        OD.Unprotect 'déprotège l'onglet OD
        'récupère la valeur de la cellule A50 [peut-être remplacé par OS.Range("A50").Copy OD.Range("A50") si tu veux aussi le format]
        OD.Range("A50").Value = OS.Range("A50").Value
        OD.Protect 'protège l'onglet OD
        CD.Close SaveChanges:=True 'ferme le classeur destination en renregistrant les changements
    End If 'fin de la condition
    FS = Dir 'redéfinit la variable FS (fichier suivant)
Loop 'boucle
MsgBox "Copie terminée !" 'message
End Sub


0