Macro excel ouvrir fichier a partir d'un mot clé

**oz2007** · 13/11/2017, 16h48

Bonjour,

J'ai essayé de trouver la réponse dans le forum mais impossible.
Voila ce que je voudrai faire grâce à un macro:

- lorsque j'ouvre mon excel une boite de dialogue s'ouvre, je saisie par exemple le mois d'octobre et cela me copie colle les informations de l'onglet " prelevement" du fichier Prelevements_S28_17102017-imputation d'OCTOBRE 2017" disponible sous le répertoire S/COtisations

Donc ma difficulté c'est que le nom du fichier change tous les mois.

Pouvez-vous m'aider svp?

Merci d'avance
VD

**BENNASR** · 13/11/2017, 16h55

bonsoir
si tu cherches à lire des données à partir d'un onglet variable voila par exemple et comme piste un code te permet de chercher une valeur d'un onglet de choix dans un classeur
j'espère que ça te permet d'avancer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Recxhrche()
Dim Y As String
Dim X As String
Dim Plage As Range
Dim Cel As Range
X = Application.InputBox("quelle est la feuille à indexer", "Valeur", Type:=2)
Sheets(X).Activate
Y = Application.InputBox("quelle est la valeur à chercher", "Valeur", Type:=2)
Set Plage = Range("A1:L500") ' à adapter
For Each Cel In Plage
If Cel.Value = Y Then
PA = Cel.Address
MsgBox ("Cette valeur se trouve dans la feuille " & X & PA)
End If
Next Cel
End Sub

l'idér c'est de saisir le nom de la feuille dans un imputbox

**BENNASR** · 13/11/2017, 17h15

à voir aussi comment aller récupérer des données dans un dossier fermé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
' Ce code me permet d'aller ouvrir un classeur qui s'appelle fichier = "RAPPORT JOURNALIER.xlsx"
' et récuperer les donnée d l'onglet AlF3 et les coller dans mon nouveau classeur
' Au démarrage de code je recoit un imputbox et je dois saisir fichier = "RAPPORT JOURNALIER"
Sub importProdVte()
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String
Dim j As Long
Application.ScreenUpdating = False
Set wkA = ThisWorkbook
X = Application.InputBox("quelle est la feuille à indexer", "Valeur", Type:=2)
chemin = "Z:\TRAVAUX COMPTABLES BNA\Controle de Gestion\"
 
Workbooks.Open chemin & X & ".xlsx"
Set wkB = ActiveWorkbook
 j = wkB.Sheets("Alf3").Range("A" & Rows.Count).End(xlUp).Row
wkA.Sheets("Feuil1").Range("C1:G" & j).Value = wkB.Sheets("Alf3").Range("D1:H" & j).Value
wkA.Sheets("Feuil1").Range("A1:B" & j).Value = wkB.Sheets("Alf3").Range("L1:M" & j).Value
 
wkB.Close True
 Application.ScreenUpdating = True
End Sub

**oz2007** · 14/11/2017, 10h22

et si je pars sur qqchose comme ça? mais là ça ne fonctionne pas je ne sais pas pourquoi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Sub test()
Application.Dialogs.Item(xlDialogOpen).Show
NomFich = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path
Workbooks.Add
NewFich = ActiveWorkbook.Name
Workbooks(NewFich).Sheets("PRELEVEMENTS").Copy After:=Workbooks(NewFich).Sheets(Workbooks(Feuil1).Sheets.Count)
Workbooks(NewFich).Close False
ActiveWorkbook.SaveAs chemin & "NouveauNom.xls"
 End Sub

**oz2007** · 14/11/2017, 13h56

Alors j'avance bien dans ma macro. Cependant elle prend beaucoup beaucoup de temps à tourner (genre 5 grosses minutes si cela ne plante pas). Y a -t'il un moyen de contourner ce problème?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Macro1()
'
' Macro1 Macro
'
 
'
 Application.Dialogs.Item(xlDialogOpen).Show
           Range("A1:AH" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveWindow.Close
    Windows("Cotisations macro.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
 
 
 
    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "Doublons"
 
 
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"
 
Dim LastRw As Long
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AI2:AI" & LastRw).FillDown
 
    Columns("AI:AI").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "Analyse doublons"
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,""pas de doublon"",""doublon"")"
    Range("AJ2").Select
 
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AJ2:AJ" & LastRw).FillDown
 
End Sub

**BENNASR** · 14/11/2017, 14h08

re au debut de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False[/B]

et à la fin du code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = True

ça te permet de gagner du temps

**BENNASR** · 14/11/2017, 14h20

Pour copier une formule vers le bas essayer avec ça peut être c'est plus rapide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Range("M3").Select
    Selection.AutoFill Destination:=Range"AI2:AI" & LastRw), Type:=xlFillDefault

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("AI2:AI" & LastRw).FillDown

je crois que est inutile de définir deux fois LastRw

**patricktoulon** · 14/11/2017, 14h39

re
bonjour
y a til des formules dans ces cellules copiées
au quel cas bloquer le calculate au début puis le débloquer a la fin a la fin serait aussi une source de gain de temps je crois

après ca, passer par adob connection serait aussi une solution peut être

**oz2007** · 14/11/2017, 14h57

En faite c'est à cause de cette formule là que la macro est très longue. Je ne vois pas d'autre moyen d'optimiser la formule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"

**oz2007** · 15/11/2017, 16h30

Bonjoru,

Je suis en train de finaliser ma macro mais lorsque je lance ma macro "nettoyer ma BDD" mes deux boutons pour lancer les macros disparaissent. Comment faire pour qu'ils ne disparaissent pas svp? CF PJ

Merci d'avance
Vanessa

**patricktoulon** · 15/11/2017, 19h37

allons vanessa
cela ne serait il pas mieux des fois ???? hein !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub MacroNettoyage()
    Cells.ClearContents
End Sub

bien que la il y aurait un peu plus a dire
peut être déterminer la plage a vider au milieu de tout le sheets hein !!???

**oz2007** · 16/11/2017, 15h33

Bonjour Patrick,

c'est nickel merci et beaucoup plus rapide

J'ai un dernier détail à régler et ma macro est ok.
Je souhaite appliquer un filtre sur ma colonne 38. Or je vois que le code passe mais le filtre de s'applique pas et je ne comprend pas pourquoi. Avez vous une idée?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Filtre sur les contrôles
Range("A1").AutoFilter field:=38, Criteria1:="Contrôle à faire"

Merci
Vanessa

**oz2007** · 16/11/2017, 16h48

Pardon Patrick mais finalement ton code ne me convient pas vraiment car il me faut quelque chose qui supprime les filtres et affiche les lignes masquées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub MacroNettoyage()
    Cells.ClearContents
End Sub

Comment faire?
Merci

**BENNASR** · 16/11/2017, 16h55

Bonsoir
Pour supprimer les filtres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
  If Worksheets("TON FEUILLE").AutoFilterMode Then
      Worksheets("TON FEUILLE").AutoFilterMode = False
   End If

Macro excel ouvrir fichier a partir d'un mot clé

Macros et VBA Excel

Discussions similaires

Partager

Partager