Transférer données d'un classeur à un autre avec condition
Bonjour chère communauté,
Je vous sollicite car j'ai besoin d'une précieuse aide pour débuter en macro.
Mon problème est le suivant :
J'ai deux classeurs, le premier nommé "Carnets bord" et le second "Base de données".
Le premier classeur "Carnets bord" a deux onglets avec des données le premier nommé "BREST- CLIO EC-358-SL" et le second "BREST- CLIO EC-439-SL".
Le second classeur "Base de données" a un onglet nommé "2019".
La macro que j'essaye de créer mais en vain doit transférer les lignes des deux onglets du classeur "Carnets bord" vers l'onglet "2019" du classeur "Base de données" si la date est bien en 2019.
Je vous remercie par avance.
Cordialement,
Bonjour,
Ton fichier "base-de-donnees.xlsx" > doit être dans le même dossier que ton fichier de travail > sinon, il faudra adapter le chemin dans le code ...
Les lignes dont l'année de la date de la colonne A qui ne sont pas 2019 sont ignorées ...
Un essai instantané > verser de l'eau chaude et remuer ...
ric
Bonjour ric,
Je te remercie pour ton retour et ta réactivité. Je prends le temps de regarder ton code et je ne manquerai pas de te faire un retour.
Je te souhaite une bonne fin de journée et à très vite
Re bonjour Ric,
Je me suis penché sur ta macro et très beau boulot!!! C'est exactement ce que je souhaitais. Grâce à toi je vais pouvoir me familiariser avec les boucles qui sont mon point faible :).
Je te remercie de nouveau pour ta disponibilité.
Je te souhaite une bonne soirée
ric
J'essaye de modifier la macro pour l’exécuter du classeur "Base de données" plutôt que du classeur "Carnet de bord".
Est-ce que tu as une piste ou c'est trop contraignant en terme de manipulation?
Bien à toi!
Bonjour,
Excel fait presque tout > sauf la vaisselle ...
Mais dis-moi > le critère de l'année (2019 dans le fichier exemple) > en plaçant le code dans le fichier de destination > doit-on mettre un facilitant pour changer d'année avec un nouveau fichier de destination ?
Si oui, est-ce que tu as une préférence où lire l'année de traitement de l'importation des données ?
ric
Pour l’année l’idéale serait un message box qui demande quelle année il faut extraire.
Après pour la demande d’extraction est-ce que c’est possible de le faire à partir du classeur « base de données » au lieu du classeur « carnet de bord ».
Je te remercie.
Bonjour,
est-ce que c’est possible de le faire à partir du classeur « base de données »
Bien sûr, ça fonctionne déjà > mais avec les noms écrits à la dure dans le code > il reste à dynamiser ...
Pour l'année > c'est bon ...
Pour l'onglet année dans le fichier cible > je présume que l'on crée un onglet pour l'année choisie > s'il n'existe pas ...
Mais, j'ai encore du questionnement > le fichier source "carnets-bord-brest-XXXX" (XXXX représentant l'année) > les onglets ...
Est-ce que les noms des 2 onglets seront toujours les mêmes ou ils varieront ?
S'ils varient > est-ce que ce sera toujours 2 onglets dans ces fichiers ?
ric
Je te remercie pour ton retour.
Les onglets changeront de nom sûrement un jour car tout change à un moment dans la vie 😬 mais disons que ce n’est pas le plus important.
Pour le nombre d’onglet effectivement ils pourront varier.
A terme il va y avoir plusieurs classeurs de « carnet de bord» c’est pour ça que dans l’idéal j’aimerais que la macro soit dans le classeur « Base de données ».
Pour la petite histoire, chaque fin d’année, je récupère des carnets de bords et je dois les copier coller dans un classeur vierge appelé « base de données ».
La création d’un onglet dans le classeur « Base de données » en fonction de l’année choisie alors ton idée est top!
Bonne soirée et merci pour ton expertise
Bonjour,
Erreur
J'ai trouvé par moi-même.
ric
Bonjour Ric,
Je n’ai pas compris ton dernier message, tu peux m’en dire plus stp?
Bonne journée
Bonjour Ric,
Qu'est ce que tu penses de cette macro sur le classeur "Base de données"?
La création d'un onglet en fonction de l'année reste un mystère pour moi.
Bonne journée
Bonjour,
Le code est intéressant > l'on y voit que les feuilles peuvent avoir des filtres activés > ce dont j'ignorais ...
Pour la création d'un onglet > l'on vérifie s'il existe (code ici bas) > s'il n'existe pas > on l'ajoute et le renomme ...
Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )
On Error GoTo SiErreur
Dim Feuille As Worksheet
FeuilleExiste = False
For Each Feuille In Worksheets
If UCase(Feuille.Name) = UCase(FeuilleAVerifier) Then
FeuilleExiste = True
Exit Function
End If
Next Feuille
Exit Function
SiErreur:
FeuilleExiste = CVErr(xlErrNA)
End FunctionJe vais faire un mélange de ton code et du mien.
A+
ric
Bonjour,
Voir si ça convient ...
Si elle n'existe pas > création de la feuille "année" comme 1re feuille ...
Attention > si elle existe > le contenu sera écrasé > ce sera à adapter au besoin ...
Éventuellement > dans un message > l'on pourrait demander " Ajouter ou Écraser" ...
Option Explicit
Dim Nom_du_fichier As String
Sub Transfert()
'se lance par les touches Ctrl+T
Dim Fichier$, an As Variant, ncol%, resu(), w As Worksheet, derlig&, tablo, i&, N&, J%
Call choix_fichiers ' choisir le fichier dont il faut importer les données
Fichier = ThisWorkbook.Path & "\" & Nom_du_fichier ' fichier à importer
If Nom_du_fichier = "" Then MsgBox "'" & Fichier & "' introuvable !", 48: Exit Sub
an = 2018 ' année par défaut à adapter
ncol = 14 ' nombre de colonnes
Do
an = Application.InputBox("Entrez l'année :", "Transfert", an) ' vérifier année
If an = False Then Exit Sub
Loop While Not an Like "####"
ReDim resu(1 To Rows.Count, 1 To ncol) ' redimentionne la variable tableau
an = Val(an) ' l'année à importer mise en valeur
Application.ScreenUpdating = False ' bloque temporairement l'affichage
Application.DisplayAlerts = False ' si le fichier est déjà ouvert
With Workbooks.Open(Nom_du_fichier) ' ouvre le fichier
For Each w In .Worksheets ' pour chacune des feuilles
If w.FilterMode Then w.ShowAllData ' si la feuille est filtrée
derlig = w.Range("A" & w.Rows.Count).End(xlUp).Row ' mémorise dernière ligne
ncol = w.Cells(6, Columns.Count).End(xlToLeft).Column ' mémorise dernière colonne
If derlig > 6 And ncol > 6 Then ' tests
tablo = w.Range("A7:A" & derlig).Resize(, ncol) ' matrice, plus rapide
For i = 1 To UBound(tablo)
If IsDate(tablo(i, 1)) And IsDate(tablo(i, 2)) Then
If Not (Year(tablo(i, 1)) > an Or Year(tablo(i, 2)) < an) Then
N = N + 1
For J = 1 To ncol
resu(N, J) = tablo(i, J)
Next J
End If
End If
Next i
Else
' au cas où une feuille n'aurait pas au moins l'entête de la ligne 6 ou au moins 6 colonnes à importer
MsgBox "Erreur ... " & Chr(10) & "le nombre de colonnes ( " & ncol & _
" ) ou le nombre de lignes ( " & derlig & " ) de la feuille ( " & w.Name & _
" ) pose problème ... veuiller vérifier le fichier."
End If
Next w
.Close False 'fermeture du fichier
End With
'---restitution---
If Not FeuilleExiste(CStr(an)) Then
' copie la feuille BDD au début (au choix)
Sheets("BDD").Copy Before:=Sheets(1)
ActiveSheet.Name = an ' renomme la feuille
ActiveSheet.Shapes.Range(Array("TextBox 1")).Delete ' supprime la zone de texte (jaune)
End If
With ThisWorkbook.Sheets(1)
If .FilterMode Then .ShowAllData ' si la feuille est filtrée
With .[A2] ' adapter éventuellement
If N Then
.Resize(N, ncol) = resu
.Resize(N, ncol).Borders.Weight = xlThin ' bordures
.Resize(N, ncol).Columns(ncol) = "=G2+N(N1)" ' formule
End If
.Cells(0, 1).Resize(N + 1, ncol).Sort .Cells(1), xlAscending, Header:=xlYes ' tri
.Offset(N).Resize(.Parent.Rows.Count - N - .Row + 1, ncol).Delete xlUp ' RAZ en dessous
End With
With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Sub choix_fichiers()
Dim Fichier As String
'cette macro permet de reprendre le nom du fichier et de le mettre dans la plage nommée
With Application.FileDialog(msoFileDialogFilePicker)
.Show
On Error Resume Next
Fichier = .SelectedItems.Item(1)
On Error GoTo 0
End With
If Fichier > "" Then Nom_du_fichier = Fichier
End Sub
Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )
On Error GoTo SiErreur
Dim Feuille As Worksheet
FeuilleExiste = False
For Each Feuille In Worksheets
If UCase(Feuille.Name) = UCase(FeuilleAVerifier) Then
FeuilleExiste = True
Exit Function
End If
Next Feuille
Exit Function
SiErreur:
FeuilleExiste = CVErr(xlErrNA)
End Functionric
Bonjour,
Code modifié afin d'ajouter la question > Ajouter ou Écraser ...
Option Explicit
Dim Nom_du_fichier As String
Sub Transfert()
'se lance par les touches Ctrl+T
Dim Fichier$, an As Variant, ncol%, resu(), w As Worksheet, derlig&, tablo, i&, N&, J%
Dim Question As Integer, Debut&
Call choix_fichiers ' choisir le fichier dont il faut importer les données
Fichier = ThisWorkbook.Path & "\" & Nom_du_fichier ' fichier à importer
If Nom_du_fichier = "" Then MsgBox "'" & Fichier & "' introuvable !", 48: Exit Sub
an = 2018 ' année par défaut à adapter
ncol = 14 ' nombre de colonnes
Do
an = Application.InputBox("Entrez l'année :", "Transfert", an) ' vérifier année
If an = False Then Exit Sub
Loop While Not an Like "####"
ReDim resu(1 To Rows.Count, 1 To ncol) ' redimentionne la variable tableau
an = Val(an) ' l'année à importer mise en valeur
Application.ScreenUpdating = False ' bloque temporairement l'affichage
Application.DisplayAlerts = False ' si le fichier est déjà ouvert
With Workbooks.Open(Nom_du_fichier) ' ouvre le fichier
For Each w In .Worksheets ' pour chacune des feuilles
If w.FilterMode Then w.ShowAllData ' si la feuille est filtrée
derlig = w.Range("A" & w.Rows.Count).End(xlUp).Row ' mémorise dernière ligne
ncol = w.Cells(6, Columns.Count).End(xlToLeft).Column ' mémorise dernière colonne
If derlig > 6 And ncol > 6 Then ' tests
tablo = w.Range("A7:A" & derlig).Resize(, ncol) ' matrice, plus rapide
For i = 1 To UBound(tablo)
If IsDate(tablo(i, 1)) And IsDate(tablo(i, 2)) Then
If Not (Year(tablo(i, 1)) > an Or Year(tablo(i, 2)) < an) Then
N = N + 1
For J = 1 To ncol
resu(N, J) = tablo(i, J)
Next J
End If
End If
Next i
Else
' au cas où une feuille n'aurait pas au moins l'entête de la ligne 6 ou au moins 6 colonnes à importer
MsgBox "Erreur ... " & Chr(10) & "le nombre de colonnes ( " & ncol & _
" ) ou le nombre de lignes ( " & derlig & " ) de la feuille ( " & w.Name & _
" ) pose problème ... veuiller vérifier le fichier."
End If
Next w
.Close False 'fermeture du fichier
End With
'---restitution---
If Not FeuilleExiste(CStr(an)) Then
' copie la feuille BDD au début (au choix)
Sheets("BDD").Copy Before:=Sheets(1)
ActiveSheet.Name = an ' renomme la feuille
ActiveSheet.Shapes.Range(Array("TextBox 1")).Delete ' supprime la zone de texte (jaune)
End If
With ThisWorkbook.Sheets(1)
If .FilterMode Then .ShowAllData ' si la feuille est filtrée
derlig = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
If derlig > 2 Then
Question = MsgBox("Il semble y avoir des données..., faut-il les conserver (Oui) ou les écraser (Non) ?", vbQuestion + vbYesNo + vbDefaultButton2, " Des données semblent présentes ...")
If Question = vbYes Then
Debut = .Cells(Rows.Count, "A").End(xlUp).Row + 1
ElseIf Question = vbNo Then
.Range("A2:N" & derlig + 10).ClearContents
Debut = 2
End If
Else
Debut = 2
End If
With .Range("A" & Debut)
If N Then
.Resize(N, ncol) = resu
.Resize(N, ncol).Borders.Weight = xlThin ' bordures
ThisWorkbook.Sheets(1).Range("A2").Resize(Debut, ncol).Columns(ncol) = "=G2+N(N1)" ' formule
End If
.Cells(0, 1).Resize(N + 1, ncol).Sort .Cells(1), xlAscending, Header:=xlYes ' tri
.Offset(N).Resize(.Parent.Rows.Count - N - .Row + 1, ncol).Delete xlUp ' RAZ en dessous
End With
With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Sub choix_fichiers()
Dim Fichier As String
'cette macro permet de reprendre le nom du fichier et de le mettre dans la plage nommée
With Application.FileDialog(msoFileDialogFilePicker)
.Show
On Error Resume Next
Fichier = .SelectedItems.Item(1)
On Error GoTo 0
End With
If Fichier > "" Then Nom_du_fichier = Fichier
End Sub
Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )
On Error GoTo SiErreur
Dim Feuille As Worksheet
FeuilleExiste = False
For Each Feuille In Worksheets
If UCase(Feuille.Name) = UCase(FeuilleAVerifier) Then
FeuilleExiste = True
Exit Function
End If
Next Feuille
Exit Function
SiErreur:
FeuilleExiste = CVErr(xlErrNA)
End Functionric
Super boulot Ric! Merci pour ta proposition!
Est-ce que c'est obligatoire de mettre le "choix du fichier" dans un sub distinct au lieu de l'intégrer au sub "Transfert"?
Pour l'onglet "BDD" la macro lit le nom de l'onglet est ce que il y a une solution pour que la macro ne prenne pas en compte ce critère de nom d'onglet?
Bien à toi!
Bonjour,
Est-ce que c'est obligatoire de mettre le "choix du fichier" dans un sub distinct au lieu de l'intégrer au sub "Transfert"?
Non > point du tout > du code c'est malléable > l'on arrange à notre goût > tant que l'arrangement est possible ...
Pour l'onglet "BDD" la macro lit le nom de l'onglet est ce que il y a une solution pour que la macro ne prenne pas en compte ce critère de nom d'onglet?
Je copie BDD pour en faire la feuille de l'année ayant déjà les entêtes de la ligne 1 ...
Si tu ne veux que le renommer au nom de l'année > cela convient aussi > c'est au goût ...
ric
Merci pour ton retour!
Je vais malaxer tout ça
Bien à toi
Deux petites questions stp :
Si je souhaite ajouter des colonnes dans la "Base de données" il faut modifier
ncol =mais quoi d'autre?
A quoi sert cette formule?
"=G2+N(N1)"