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

Version imprimable

13/11/2017, 16h48
oz2007

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

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

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:

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

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

Code:

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

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

Code:

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

lenteur de la macro

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:

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

14/11/2017, 14h08
BENNASR

re au debut de code

Code:

Application.ScreenUpdating = False[/B]

et à la fin du code

Code:

Application.ScreenUpdating = True

ça te permet de gagner du temps
14/11/2017, 14h20
BENNASR
Pour copier une formule vers le bas essayer avec ça peut être c'est plus rapide
Code:

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

Code:

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

je crois que est inutile de définir deux fois LastRw
14/11/2017, 14h39
patricktoulon

re

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
14/11/2017, 14h57
oz2007

lenteur macro
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:

1 2 3 Range("AI2").Select ActiveCell.FormulaR1C1 = _ "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"
15/11/2017, 16h30
oz2007

1 pièce(s) jointe(s)

bouton de commande qui s'effacent

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
15/11/2017, 19h37
patricktoulon

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

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 !!???
16/11/2017, 15h33
oz2007

prob de filtre
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:

1 2 'Filtre sur les contrôles Range("A1").AutoFilter field:=38, Criteria1:="Contrôle à faire"
Merci
Vanessa
16/11/2017, 16h48
oz2007

suppression filtre
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:

1 2 3 Sub MacroNettoyage() Cells.ClearContents End Sub
Comment faire?
Merci

Bonsoir
Pour supprimer les filtres

Code:

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