XL 2016 VBA - Copier fichier destination selon filtre date

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
J

james7734

XLDnaute Junior
Bonjour à tous,

Je possède deux fichiers Excel: 1 fichier source avec des opérations (une nouvelle ligne par opération et par date); et 1 fichier sur lequel j'aimerais importer les données du fichier source (New).

Je cherche un moyen VBA d'importer (copier-coller) dans le fichier New, onglet 'Mouvements', seulement les colonnes indiqués et selon la date indiqué en B2 de l'onglet 'Date'. (Exemple: si je met 14/09/2020 en B2, seule les 5 lignes du 14/9 s'importent). Un exemple de sorti est déjà sur le fichier 'New'. Mon fichier source original a en réalité beaucoup plus de lignes et d'onglets, pour info. Le fichier source reste au même endroit dans un répertoire.

Je cherche spécifiquement à réaliser cela sur VBA et je ne suis pas sûr quant à la meilleure manière de m'y prendre.

Merci!
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Bien
Alors voici un début de solution, à voir plus précisément comment tu veux traiter les données
J'ai ajouter un"nom"dans la feuille, pour lister les champs à récupérer.
Je ne traite pas si le champs cherché n'existe pas dans la feuille mouvement, à voir toujours dans ta façon de voir les choses
 

Pièces jointes

Vote positif 0 Vote négatif
Bonsoir james7734, sousou,

Téléchargez les fichiers joints dans le même dossier (le bureau).

La macro dans la feuille Date utilise le filtre avancé :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Dim F As Worksheet, dat As Variant, chemin$, fichier$
Set F = Feuil2 'CodeName
F.Rows("2:" & F.Rows.Count).Delete 'RAZ
dat = [B2]
If Not IsDate(dat) Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
On Error Resume Next: Workbooks(fichier).Close False: On Error GoTo 0 'si le fichier est ouvert on le ferme
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'évite les avertissements de mise à jour des liaisons
With Workbooks.Open(chemin & fichier)
    With .Sheets(1).[A1].CurrentRegion
        .Cells(2, .Columns.Count + 1) = "=A2=" & CLng(CDbl(dat)) 'critère
        .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 1).Resize(2), F.[A1].CurrentRegion 'filtre avancé
    End With
    .Close False
End With
F.Activate
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
En toute rigueur il faut aussi mettre à jour la feuille "Mouvements" quand le fichier est activé car le fichier Source.xlsx a pu être modifié, voyez ce fichier (2).

Dans ThisWorkbook :
VB: 
Private Sub Workbook_Activate()
MAJ
End Sub
Dans le code de la feuille Date :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B2]) Is Nothing Then MAJ
End Sub
Dans Module1 :
VB: 
Sub MAJ()
Dim F As Worksheet, dat As Variant, chemin$, fichier$
Set F = Feuil2 'CodeName
F.Rows("2:" & F.Rows.Count).Delete 'RAZ
dat = Feuil1.[B2]
If Not IsDate(dat) Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
On Error Resume Next: Workbooks(fichier).Close False: On Error GoTo 0 'si le fichier est ouvert on le ferme
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'évite les avertissements de mise à jour des liaisons
Application.EnableEvents = False 'désactive les évènements
With Workbooks.Open(chemin & fichier)
    With .Sheets(1).[A1].CurrentRegion
        .Cells(2, .Columns.Count + 1) = "=A2=" & CLng(CDbl(dat)) 'critère
        .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 1).Resize(2), F.[A1].CurrentRegion 'filtre avancé
    End With
    .Close False
End With
F.Activate
Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
En toute rigueur il faut aussi mettre à jour la feuille "Mouvements" quand le fichier est activé car le fichier Source.xlsx a pu être modifié, voyez ce fichier (2).

Dans ThisWorkbook :
VB: 
Private Sub Workbook_Activate()
MAJ
End Sub
Dans le code de la feuille Date :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B2]) Is Nothing Then MAJ
End Sub
Dans Module1 :
VB: 
Sub MAJ()
Dim F As Worksheet, dat As Variant, chemin$, fichier$
Set F = Feuil2 'CodeName
F.Rows("2:" & F.Rows.Count).Delete 'RAZ
dat = Feuil1.[B2]
If Not IsDate(dat) Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
On Error Resume Next: Workbooks(fichier).Close False: On Error GoTo 0 'si le fichier est ouvert on le ferme
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'évite les avertissements de mise à jour des liaisons
Application.EnableEvents = False 'désactive les évènements
With Workbooks.Open(chemin & fichier)
    With .Sheets(1).[A1].CurrentRegion
        .Cells(2, .Columns.Count + 1) = "=A2=" & CLng(CDbl(dat)) 'critère
        .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 1).Resize(2), F.[A1].CurrentRegion 'filtre avancé
    End With
    .Close False
End With
F.Activate
Application.EnableEvents = True 'réactive les évènements
End Sub
Cliquez pour agrandir...
Merci beaucoup! c'est ce que je voulais! j'ai même pu adapter le chemin répertoire.
 
Dernière édition:
Vote positif 0 Vote négatif
job75 à dit:
En toute rigueur il faut aussi mettre à jour la feuille "Mouvements" quand le fichier est activé car le fichier Source.xlsx a pu être modifié, voyez ce fichier (2).

Dans ThisWorkbook :
VB: 
Private Sub Workbook_Activate()
MAJ
End Sub
Dans le code de la feuille Date :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B2]) Is Nothing Then MAJ
End Sub
Dans Module1 :
VB: 
Sub MAJ()
Dim F As Worksheet, dat As Variant, chemin$, fichier$
Set F = Feuil2 'CodeName
F.Rows("2:" & F.Rows.Count).Delete 'RAZ
dat = Feuil1.[B2]
If Not IsDate(dat) Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
On Error Resume Next: Workbooks(fichier).Close False: On Error GoTo 0 'si le fichier est ouvert on le ferme
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'évite les avertissements de mise à jour des liaisons
Application.EnableEvents = False 'désactive les évènements
With Workbooks.Open(chemin & fichier)
    With .Sheets(1).[A1].CurrentRegion
        .Cells(2, .Columns.Count + 1) = "=A2=" & CLng(CDbl(dat)) 'critère
        .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 1).Resize(2), F.[A1].CurrentRegion 'filtre avancé
    End With
    .Close False
End With
F.Activate
Application.EnableEvents = True 'réactive les évènements
End Sub
Cliquez pour agrandir...
Serait-il également possible de mettre une MsgBox si jamais il n'y a rien pour la date choisie? Car autrement, le code plante si il ne trouve pas la date...
 
Vote positif 0 Vote négatif
job75 à dit:
Non car la macro ne plante pas dans ce cas, sauf si vous avez modifié mon code.

Chez moi quand la date n'est pas trouvée la feuille "Mouvements" ne contient que les en-têtes.
Cliquez pour agrandir...
Merci pour ton aide, en effet j'ai pu rectifier. Maintenant, le problème est que mon fichier source contient à un endroit un saut de plusieurs lignes qui empêchent de prendre en compte les données après le saut de ligne.
Je pense que le ".Sheets(1).[A1].CurrentRegion" est la raison?
 
Vote positif 0 Vote négatif
job75,

Merci énormément pour ton aide, mais je rencontre le pb suivant de mon côté: "Run time error '1004' app-defined or object-defined error" sur la ligne suivante:

.Cells(2, .Columns.Count + 1) = "=A2=" & CLng(CDbl(dat)) 'critère

A quoi correspond '=A2=' ? et CLng / CDbl ?
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

E
  • Question Question
XL 2021 Identifier de manières fiables les colonnes d'un fichier Excel pour une macro VBA
Réponses
2
Affichages
501
excelentille
E
A
  • Question Question
XL 2019 Copier une plage dans un fichier fermé en VBA
2
Réponses
21
Affichages
2 K
Amilo
A
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
778
oguruma
oguruma
B
  • Question Question
Microsoft 365 filtre sur Date VBA dans liste box
Réponses
1
Affichages
792
fanch55
fanch55
C
  • Résolu(e)
XL 2016 VBA Boucle Copier Coller Dynamique
Réponses
5
Affichages
1 K
Cocoraphsg
C
L
  • Question Question
XL 2013 VBA - Copier des lignes d'un autre classeur sur base d'une valeur
Réponses
0
Affichages
2 K
lestatber
L
Y
  • Question Question
XL 2019 filtre sur Date VBA dans liste box
Réponses
2
Affichages
861
youpi457032
Y
A
  • Question Question
Microsoft 365 Macro copier selon critères
Réponses
1
Affichages
914
Lolote83
L
J
  • Question Question
XL 2016 Importer données depuis fichier source - VBA
Réponses
0
Affichages
2 K
james7734
J
J
  • Résolu(e)
XL 2010 VBA Copier cellules selon condition
Réponses
1
Affichages
1 K
fanfan38
fanfan38
M
  • Question Question
XL 2010 Copier/coller des cellules non contiguës dans un nouveau classeur
Réponses
4
Affichages
3 K
Staple1600
Staple1600
V
  • Question Question
XL 2010 Remplissage de bulletin de transfert de stock selon la date depuis base de données articles (colonne variable)
Réponses
5
Affichages
1 K
Varenshar
V
S
  • Résolu(e)
XL 2010 VBA Copie plages cellule fichiers sources vers fichier dest
Réponses
6
Affichages
2 K
spike29
S
R
  • Question Question
XL 2019 lister fichier avec exifs ou propriétés
Réponses
1
Affichages
2 K
fanch55
fanch55
J
  • Résolu(e)
XL 2016 VBA code condition date
Réponses
4
Affichages
675
Staple1600
Staple1600
OliVBB
  • Question Question
Calcul du nombre d'heures en fonction de dates - 3 conditions (Sans VBA)
Réponses
5
Affichages
1 K
OliVBB
OliVBB
G
  • Question Question
XL 2013 Figer les valeurs après macro
Réponses
3
Affichages
2 K
danielco
D
F
  • Résolu(e)
XL 2016 VBA copier certaines cellules d un fichier à un autre sous conditions
Réponses
2
Affichages
1 K
Fabien35200
F
A
  • Question Question
XL 2016 macro : copier un tableau excel dans word en métafichier
Réponses
2
Affichages
2 K
herve62
herve62
W
  • Question Question
XL 2013 Copier cellules avec plusieurs conditions
Réponses
1
Affichages
1 K
WIsh_
W
Retour