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