Taches répétitives

H

Henriett

XLDnaute Occasionnel
Bonjour,

J' ai un petit-grand problème avec excel.
En effet, j' ai des dizaines de fichiers excel dans lesquels je dois toujours effectuer les même taches.
J' aimerais savoir s' il existe un moyen pour que quand, par exemple je sélectionne une plage de cellules (A1 B7 dans la feuil3)dans un fichier(ou classeur) ,"témoin" ou premier, eh bien dans tous les autres fichiers excel que j' aurais choisis, cet même selection se fera (A1 B7 dans la feuil3). Et si je veux copier cette même plage et la coller dans la feuil6 par exemple, eh bien chaque fichier prendra chacun sa plage de cellules(A1 B7 dans la feuil3) pour la coller dans sa propre feuil6.
Enfin bref, c' est juste pour savoir s' il existe un genre de programmation ou de quelque chose à faire dans excel pour que ça marche.

J' espère que quelqu' un me comprendra.:)

Cordialement,
 
Trier par date Trier par votes
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Désolé, je n'avais pas assez nettoyé (et il reste encore du ménage à faire :p)
Code: 
Sub Macro2bis()
    Sheets("Feuil2").Range("K4:M9") = 4
    Sheets("Feuil2").Range("K4:M9").Copy
    Sheets("Feuil3").Range("AF2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil4").Range("AE21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil5").Range("AE32").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil3").Select
    Range("AF1").FormulaR1C1 = "31"
    Columns("B:AF").Copy Range("AK1")
    Sheets("Feuil3").Range("AK2").FormulaR1C1 = "=IF(RC[-35]=""X"",RC[1]+1,0)"
    Range("AK2").FormulaR1C1 = "=IF(RC[-35]=""X"",RC[-1]+1,0)"
    Range("AK2").AutoFill Destination:=Range("AK2:BO2"), Type:=xlFillDefault
    Range("AK2:BO2").AutoFill Destination:=Range("AK2:BO100001"), Type:=xlFillDefault
    Columns("A:AE").Copy Range("AJ1")
    Sheets("Feuil5").Select
    Columns("A:AE").Copy Range("AJ1")
    Sheets("Feuil3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil4").Range("AJ2").FormulaR1C1 = "=IF(RC[-35]=""X"",RC[-1]+1,0)"
    Range("AJ2").AutoFill Destination:=Range("AJ2:BN2"), Type:=xlFillDefault
    Range("AJ2:BN2").AutoFill Destination:=Range("AJ2:BN100047"), Type:=xlFillDefault
    Range("AJ2:BN100047").Copy Sheets("Feuil5").Range("AJ2")
    Sheets("Feuil4").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil5").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil2").Select
    ActiveSheet.Shapes.Range(Array("Zone de texte 1")).Select
End Sub
Bon WE :cool:
 
Vote positif 0 Vote négatif
H

Henriett

XLDnaute Occasionnel
Re : Taches répétitives

Re,

J' ai essayé ce code comme tu l' as nettoyé mais il y a plein d' erreurs.:confused:

Mais comme je m' ennuiyais, j' ai essayé le code que je t' avais envoyé hier et il se trouve que je l' ai observé et il attendait que le processeur fasse le calcul. J' ai vérifié si il n'y avait pas d' erreurs et je n' en ai pas trouvé mais comme le fichier est grand, peut-être que j' en ai manqué.:)

Merci encore. Je n' ai plus à effectuer des tâches répétitives à part ouvrir tous mes fichiers ; Je me suis donc demandée si il existait un moyen de lancer une macro pour plusieurs fichiers en même temps, d' un coup... ?

Bon week-end à tous,

Cordialement,
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Henriett à dit:
Je n' ai plus à effectuer des tâches répétitives à part ouvrir tous mes fichiers ; Je me suis donc demandée si il existait un moyen de lancer une macro pour plusieurs fichiers en même temps, d' un coup... ?
Cliquez pour agrandir...
Sans problème :p.
Fait une petite recherche sur "ouvrir plusieurs fichiers", et tu trouveras plein de réponse comme celle-là par exemple :D
Bon courage :cool:
 
Vote positif 0 Vote négatif
H

Henriett

XLDnaute Occasionnel
Re : Taches répétitives

Bonsoir,

J' ai fais des recherches et j' ai retrouver des codes mais quand je les appliques ça ne marche pas.
Ouvrir tous les fichiers ne me dérange pas ( ctrl et je sélectionne tous les fichiers à ouvrir et hop ) mais attendre que chaque classeur a fini avec sa macro pour pouvoir la lancer dans un autre classeur, c' est plutôt...donc si je pouvais éxécuter une macro pour plusieurs classeurs en même temps...


Cordialement,
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Tiré du fil précité
Code: 
Sub Traitement()
Dim wbk As Workbook
Dim Fich As String
Application.ScreenUpdating = False
Fich = Dir("[COLOR=red]C:\Users\M\Documents\[/COLOR]*.xls")
Do While Fich <> ""
Set wbk = Workbooks.Open("[COLOR=red]C:\Users\M\Documents\[/COLOR]" & Fich)
wbk.Activate
Call [COLOR=red]Macro1[/COLOR]
Call [COLOR=red]Macro2[/COLOR]
wbk.Save
wbk.Close False
Fich = Dir
Set wbk = Nothing
Loop
Application.ScreenUpdating = True
End Sub
en n'oubliant pas de changer le chemin d'accès à ton dossier, le nom des macros que tu veux appeler pour traitement, et surtout une sauvegarde de tes fichiers avant de lancer la macro, car l'enregistrement sera automatique après chaque macro :eek:
Bon courage :cool:
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Henriett à dit:
J' ai ajouté ce code à module dans modules qui est dans personal.xlsb
OK
puis je l ai exécuter dans chaque classeur,
Comment cela ? Il faut juste ouvrir un classeur neutre, tous les autres classeurs fermés, et lancer la macro :confused:...
puis j' ai lancer ma macro mais elle n' est éxecutée que dans un classeur.
Tu n'as plus à lancer ta macro, elle est appelé par la mienne :eek:
Cliquez pour agrandir...
As-tu bien changé les lignes que j'avais laissé en rouge dans ma macro ?
Bonne soirée :cool:
 
Vote positif 0 Vote négatif
H

Henriett

XLDnaute Occasionnel
Re : Taches répétitives

Re,

J' ai réessayer et ça ne marche pas. Voilà ce que j' ai fais :

Dans mon classeur neutre, dans personal.xlsb, dans modules, dans module1 j' ai collée ce code composé d' une macro1, 2 et le traitement :

Code: 
Sub Macro1()
'
' Macro1 Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+C
'
    Range("K4:M9").Select
    Range("K9").Activate
    Selection.Copy
    Sheets("Feuil2").Select
    Range("K10").Select
    ActiveSheet.Paste
End Sub
Sub Macro2()
'
' Macro2 Macro
'
' Touche de raccourci du clavier: Ctrl+m
'
    Sheets("Feuil2").Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("AF2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil4").Select
    ActiveWindow.ScrollRow = 64934
    ActiveWindow.ScrollRow = 64724
    ActiveWindow.ScrollRow = 64514
    ActiveWindow.ScrollRow = 64304
    ActiveWindow.ScrollRow = 63253
    ActiveWindow.ScrollRow = 60731
    ActiveWindow.ScrollRow = 59471
    ActiveWindow.ScrollRow = 56529
    ActiveWindow.ScrollRow = 54217
    ActiveWindow.ScrollRow = 49804
    ActiveWindow.ScrollRow = 41189
    ActiveWindow.ScrollRow = 39928
    ActiveWindow.ScrollRow = 36566
    ActiveWindow.ScrollRow = 28791
    ActiveWindow.ScrollRow = 23747
    ActiveWindow.ScrollRow = 19545
    ActiveWindow.ScrollRow = 15552
    ActiveWindow.ScrollRow = 2
    Range("AE21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=18
    Sheets("Feuil5").Select
    ActiveWindow.SmallScroll Down:=20
    Range("AE32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil3").Select
    Columns("B:AF").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AF1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "31"
    Columns("B:AF").Select
    Range("AF1").Activate
    Selection.Copy
    Range("AK1").Select
    ActiveSheet.Paste
    Sheets("Feuil2").Select
    ActiveSheet.Shapes.Range(Array("Text Box 1")).Select
    Application.CutCopyMode = False
    Sheets("Feuil3").Select
    Range("AK2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-35]=""X"",RC[1]+1,0)"
    Range("AK2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-35]=""X"",RC[-1]+1,0)"
    Range("AK2").Select
    Selection.AutoFill Destination:=Range("AK2:BO2"), Type:=xlFillDefault
    Range("AK2:BO2").Select
    Selection.AutoFill Destination:=Range("AK2:BO100001"), Type:=xlFillDefault
    Range("AK2:BO100001").Select
    Selection.Copy
    Sheets("Feuil4").Select
    Columns("A:AE").Select
    Range("AE1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Range("AJ1").Select
    ActiveSheet.Paste
    Sheets("Feuil5").Select
    Columns("A:AE").Select
    Range("AE1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Range("AJ1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-20
    Sheets("Feuil4").Select
    ActiveWindow.SmallScroll Down:=-18
    Sheets("Feuil3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil2").Select
    Application.CutCopyMode = False
    Sheets("Feuil4").Select
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-35]=""X"",RC[-1]+1,0)"
    Range("AJ2").Select
    Selection.AutoFill Destination:=Range("AJ2:BN2"), Type:=xlFillDefault
    Range("AJ2:BN2").Select
    Selection.AutoFill Destination:=Range("AJ2:BN100047"), Type:=xlFillDefault
    Range("AJ2:BN100047").Select
    Selection.Copy
    ActiveWindow.ScrollRow = 99818
    ActiveWindow.ScrollRow = 94354
    ActiveWindow.ScrollRow = 82376
    ActiveWindow.ScrollRow = 67457
    ActiveWindow.ScrollRow = 54218
    ActiveWindow.ScrollRow = 48754
    ActiveWindow.ScrollRow = 44551
    ActiveWindow.ScrollRow = 43711
    ActiveWindow.ScrollRow = 43501
    ActiveWindow.ScrollRow = 41189
    ActiveWindow.ScrollRow = 26059
    ActiveWindow.ScrollRow = 7567
    ActiveWindow.ScrollRow = 2
    Sheets("Feuil5").Select
    Range("AJ2").Select
    ActiveSheet.Paste
    Sheets("Feuil4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil2").Select
    ActiveSheet.Shapes.Range(Array("Zone de texte 1")).Select
End Sub
Sub Traitement()
Dim wbk As Workbook
Dim Fich As String
Application.ScreenUpdating = False
Fich = Dir("C:\Users\user\Documents\Nouveau dossier.xls")
Do While Fich <> ""
Set wbk = Workbooks.Open("C:\Users\user\Documents\Nouveau dossier" & Fich)
wbk.Activate
Call Macro2
wbk.Save
wbk.Close False
Fich = Dir
Set wbk = Nothing
Loop
Application.ScreenUpdating = True
End Sub

Tous les classeurs qui sont dans mon Nouveau dossier sont fermés. Seul le classeur neutre est ouvert et je lance la macro traitement avec Macros dans Personal.xlsb que j' exécute. Ensuite quand j' ouvre mes classeurs rien n' a changé.

Cordialement,
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Tu t'est trompé dans les chemins :p...
Code: 
Fich = Dir("C:\Users\user\Documents\Nouveau dossier[COLOR=red][B]\*[/B][/COLOR].xls")
Do While Fich <> ""
Set wbk = Workbooks.Open("C:\Users\user\Documents\Nouveau dossier[COLOR=red][B]\[/B][/COLOR]" & Fich)
Bonne nuit :cool:
 
Vote positif 0 Vote négatif
H

Henriett

XLDnaute Occasionnel
Re : Taches répétitives

Bonjour,

Après correction, la macro traitement marche bien :)
Merci beaucoup d' avoir répondu à tous mes besoins et d' avoir toujours répondu si vite à mes questions;)

J' ai juste une dernière chose à te demander et après, promis ( enfin j' espère ), je te laisserais tranquille.

En fait, j' aimerais pouvoir rechercher dans une colonne précise un mot ou un chiffre... dans plusieurs classeurs en même temps( et des feuilles précises dans ces classeurs) parce que dans Rechercher et Sélectionner, on peut recherche dans Feuille, dans Classeur mais pas dans Tous les Classeurs... ?

Bonne après-midi,

Cordialement,
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Henriett à dit:
J' ai juste une dernière chose à te demander et après, promis ( enfin j' espère ), je te laisserais tranquille.
Cliquez pour agrandir...
Des promesses, toujours des promesses :p...
Effectivement, je ne pense pas que le rechercher puisse être utilisé avec plusieurs classeurs.
Par contre, par macro :
VB: 
Sub RechercheMulti()
Dim Classeur As Workbook, Feuille As Worksheet, AChercher As String
Dim Cellule As Range, firstAddress As String, CompteRendu As String
AChercher = InputBox("Mot à chercher ?", "Recherche dans les classeurs ouverts")
For Each Classeur In Workbooks
For Each Feuille In Classeur.Worksheets
On Error Resume Next
With Feuille.Cells.SpecialCells(xlCellTypeConstants)
' Remplacer par Feuille.range("A1:A500") par exemple pour cibler
Set Cellule = .Find(AChercher, LookIn:=xlValues, LookAt:=xlWhole)
'Remplacer xlWhole par xlPart pour chercher une partie
If Not Cellule Is Nothing Then
firstAddress = Cellule.Address
Do
CompteRendu = CompteRendu & "Classeur : " & Classeur.Name & " - Feuille : " _
& Feuille.Name & " - Cellule : " & Cellule.Address & vbCrLf
Set Cellule = .FindNext(Cellule)
Loop While Not Cellule Is Nothing And Cellule.Address <> firstAddress
End If
End With
On Error GoTo 0
Next
Next
MsgBox CompteRendu
End Sub
Je t'ai mis les modifs à faire si tu veux chercher sur une partie du mot, ou si tu veux cibler ta zone de recherche.
La recherche se fait uniquement sur les constantes. Si tu veux chercher dans le résultat des formules, il faut changer xlCellTypeConstants par xlCellTypeFormulas.
Bon courage :cool:
 
Dernière édition:
Vote positif 0 Vote négatif
H

Henriett

XLDnaute Occasionnel
Re : Taches répétitives

Bonsoir,

J' ai essayé la macro recherche sur un seul classeur et ça marche mais je sais que j' ai énormément de résultats mais la macro n' affiche que 13 ( ou 12 je sais plus ) résultats alors qu' il y en a bien plus.

Cordialement,

Code: 
Sub RechercheMulti()
Dim Classeur As Workbook, Feuille As Worksheet, AChercher As String
Dim Cellule As Range, firstAddress As String, CompteRendu As String
AChercher = InputBox("Mot à chercher ?", "Recherche dans les classeurs ouverts")
For Each Classeur In Workbooks
For Each Feuille In Classeur.Worksheets
On Error Resume Next
With Feuille.Range("A1:A500").SpecialCells(xlCellTypeConstants)
    Set Cellule = .Find(AChercher, LookIn:=xlValues, LookAt:=xlPart)
        If Not Cellule Is Nothing Then
        firstAddress = Cellule.Address
        Do
            CompteRendu = CompteRendu & "Classeur : " & Classeur.Name & " - Feuille : " _
                & Feuille.Name & " - Cellule : " & Cellule.Address & vbCrLf
            Set Cellule = .FindNext(Cellule)
        Loop While Not Cellule Is Nothing And Cellule.Address <> firstAddress
    End If
End With
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Taches répétitives

Re :),
Le but d'une recherche, c'est pas 500 résultats, c'est quelques uns :p...
Soit tu dépasses la taille de la String, essaie
Code: 
Sub RechercheMulti()
Dim Classeur As Workbook, Feuille As Worksheet, AChercher As String
Dim Cellule As Range, firstAddress As String, CompteRendu As String
AChercher = InputBox("Mot à chercher ?", "Recherche dans les classeurs ouverts")
For Each Classeur In Workbooks
For Each Feuille In Classeur.Worksheets
On Error Resume Next
With Feuille.Range("A1:A500").SpecialCells(xlCellTypeConstants)
    Set Cellule = .Find(AChercher, LookIn:=xlValues, LookAt:=xlPart)
        If Not Cellule Is Nothing Then
        firstAddress = Cellule.Address
        Do
            CompteRendu = CompteRendu & Classeur.Name & " : " _
                & Feuille.Name & " : " & Cellule.Address & vbCrLf
            Set Cellule = .FindNext(Cellule)
        Loop While Not Cellule Is Nothing And Cellule.Address <> firstAddress
    End If
End With
On Error GoTo 0
Next
Next
MsgBox CompteRendu
End Sub
j'ai plus de 30 résultats trouvés. Si tu en veux plus, il va falloir écrire les résultats quelque part :rolleyes:...
Soit tu attends des résultats qui sont issus de formules, ce qui n'est pas pris en compte par xlCellTypeConstants comme indiqué précédement ;).
Bonne nuit :cool:
 
Vote positif 0 Vote négatif
H

Henriett

XLDnaute Occasionnel
Re : Taches répétitives

Bonjour,

En effet, il affiche une trentaine de résultats mais j' ai bien plus de résultats. Ce qu' il faudrait serait un curseur pour monter et descendre afin d' afficher tous les résultat.
Ce n' est que des constantes que je recherche.

Bonne journée,

Cordialement,
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2010 Récupération de données et les transformer avec Power Query ?
Réponses
3
Affichages
258
DJunqueira
D
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
158
GClaire
G
J
  • Question
XL 2021 Segments et tcd non liés
Réponses
4
Affichages
301
chris
chris
C
  • Question
Microsoft 365 copier coller en changeant la disposition et plage de donnees variable
Réponses
5
Affichages
458
cg1980
C
Julie-F
  • Question
XL 2016 Base puis création de fichiers multiples sous une présentation similaire
Réponses
5
Affichages
371
Julie-F
Julie-F
J
  • Question
XL 2019 sélection et mise en page avant envoie mail
Réponses
5
Affichages
363
sylvanu
sylvanu
A
  • Résolu(e)
XL 2016 Plage de données fixes pour calcul dans formule
Réponses
3
Affichages
122
sylvanu
sylvanu
S
  • Résolu(e)
Microsoft 365 Fonction indirect
2
Réponses
24
Affichages
1 K
Spidtrip
S
P
  • Question
Microsoft 365 Problèmes multipages dans usf
2
Réponses
16
Affichages
667
ChTi160
ChTi160
A
  • Résolu(e)
Microsoft 365 Envoi mail avec plusieurs PJ vba
Réponses
5
Affichages
320
Arnaud H
A

Membres actuellement en ligne

23 membres et 368 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 297
Messages
2 086 972
Membres
103 412
dernier inscrit
antoire