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
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
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
27 mai 2015 à 22:34
Bonsoir Al, bonsoir le forum,
Comment t'aider avec une question aussi vague ?!
- Dans quel dossier se trouvent-ils ?
- Qu'ont-ils en commun ?
- Quelle l'extension ?
Fait un effort pour fournir des explication précises et je suis sûr que tu obtiendras rapidement des réponses.
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.
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
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.
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.
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
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 :
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 :
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.
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.
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
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
Pour tes deux macros ThauTheme erreur 1004 ou alors copie réussie mais uniquement dans le fichier source???
A l aide
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
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
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 :
À 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