Extraire des données vers un autre classeur

Bonjour à tous,

Pouvez-vous m'aider à trouver la solution?

Je dois extraire des données d'un classeur vers un autre, jusque là tout va bien(code ci-dessous).

La problématique est que le fichier comporte la date du jour (Product Revenue 21/11/18.xls) donc à chaque fois je dois renommer le classeur sans la date!

Pensez-vous qu'il est possible d'ajouter une ligne de code pour palier à ça?

Merci d'avance pour votre aide.

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Application.EnableEvents = False

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1

Workbooks("CALCUL CA.xlsm").Sheets("Calcul CA").Range("D9:L3000") = Workbooks("Product Revenue.xls").Sheets("ProductMixRevenue").Range("C14:K3000").Value

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

Cordialement,

Setila

Hello tout le monde,

J'ai essayé la fonction Like mais ça ne fonctionne pas!

Ensuite j'ai tenté la fonction dir :

Private Sub CommandButton2_Click()

Dim NomFic As String

NomFic = Dir("C:\Users\Ali\Desktop\.xls " & "Product Revenue*.xls")

Application.ScreenUpdating = False

Application.EnableEvents = False

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1

Workbooks("CALCUL CA.xlsm").Sheets("Calcul CA").Range("D9:L3000") = Workbooks("NomFic").Sheets("ProductMixRevenue").Range("C14:K3000").Value

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

Mais ça ne fonctionne pas!!!

Help please!!!

Merci d'avance,

Setila

Salut,

Essaye comme ca...

NomFic = Dir("C:\Users\Ali\Desktop\.xls " & "Product Revenue*" & ".xls"

Private Sub CommandButton2_Click()

Dim NomFic As String

NomFic = Dir("C:\Users\Ali\Desktop\.xls" & "Product Revenue*" & ".xls")

Application.ScreenUpdating = False

Application.EnableEvents = False

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1

Workbooks("CALCUL CA.xlsm").Sheets("Calcul CA").Range("D9:L3000") = Workbooks("NomFic").Sheets("ProductMixRevenue").Range("C14:K3000").Value

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

Erreur d'execution "9":

L'indice n'appartient pas à la selection

????

Merci pour ton aide

Setila

Essaye de faire cette macro avec un nom de classeur sans les "/" et une date sans espace.

Exemple : 22/11/2018 = 22112018

Sinon essaye ca : NomFic = Dir("C:\Users\Ali\Desktop\.xls" & "Product Revenue*" & "/*" & "/*" & ".xls")

Hello,

non toujours pas!

le fichier se nome avec des points : Product Revenue 17.11.18

cdt,

Setila

Remplace les / avec les points .

Hello,

Toujours la même Erreur :

Erreur d'execution "9":

L'indice n'appartient pas à la selection

Private Sub CommandButton2_Click()

Dim NomFic As String

NomFic = Dir("C:\Users\Ali\Desktop\.xls" & "Product Revenue*" & ".*" & ".*" & ".xls")

Application.ScreenUpdating = False

Application.EnableEvents = False

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1

Workbooks("CALCUL CA.xlsm").Sheets("Calcul CA").Range("D9:L3000") = Workbooks("NomFic").Sheets("ProductMixRevenue").Range("C14:K3000").Value

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

Setila

Essaie d’enlver le Dir()

pareil....je deviens fou!!!

merci

Y a t il une autre solution?

Setila

Salut,

La date devant ton "Product Revenue" est tjr aujourd'hui?

De plus, on ne peut pas nommer un fichier excel avec des "/".

J'attend tes réponses et je t'envoie qlqc

Salut,

Oui la date du fichier est principalement du jours sauf si je dois extraire le fichier de la veille!

En effet, le fichier est comme ceci : Product Revenue23.11.18

Merci,

Setila

Salut,

Voila deux fichier, il faudra juste copie coller la macro, mais attention à copier les cellules des dates dans "CALCUL CA".

La macro cherche le fichier "Product Revenue" de aujourd’hui ou bien écrit tes dates manuellement dans les cellules.

Attention à la macro elle est adapté à mon ordi, ci joint la bonne macro :

Sub Importation()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

NomFic = ActiveSheet.Range("N3").Value & "." & ActiveSheet.Range("N4").Value & "." & ActiveSheet.Range("N5").Value

Workbooks.Open Filename:= _
        "C:\Users\??\Desktop\Product Revenue " & NomFic & ".xlsm"

Worksheets("ProductMixRevenue").Activate

Range("D9:L3000").Value = ThisWorkbook.Sheets("Calcul CA").Range("D9:L3000").Value

Application.AlertBeforeOverwriting = False
ActiveWorkbook.Save
ActiveWorkbook.Close ' pour fermer le fichier '
Application.AlertBeforeOverwriting = True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Hello Vaffancolor,

Merveilleux, incroyable, génial ….

Bravo et un grand merci, je viens de l’adapter au fichier et il fonctionne parfaitement, de plus je ne suis plus obligé d’ouvrir le classeur(Whouuuu)

Merci à tous, vous êtes au top !

Bonne journée,

Setila

De rien ^^

Après tu peux rajouter des codes qui vérifie si le classeur est déjà ouvert ou bien qui le ferme automatiquement avant la copie.