XL 2016 Copier Coller données avec VBA dernière cellules vide

A

Anto35200

XLDnaute Occasionnel
Bonjour,
A partir du fichier « extraction », je souhaiterai pouvoir copier, avec une macro, à partir de la ligne 2 jusqu’à la dernière ligne vide, et le coller dans le fichier « BD » à la suite des données déjà présentes, c’est-à dire à la ligne 13.
En gros, je dois au quotidien, faire une extraction des données et le copier dans le fichier BD.

En vous remerciant de votre aide que vous pourrez m'apporter.
 

Pièces jointes

  • Extraction.xlsx
    9.8 KB · Affichages: 7
  • BD.xlsx
    10 KB · Affichages: 6
Solution
job75
Bonjour,

On me snobe mais je m'en fiche :
VB: 
Sub Copier()
Dim fichier1$, fichier2$, c As Range
fichier1 = ThisWorkbook.Path & "\BD.xlsx"
fichier2 = ThisWorkbook.Path & "\Extraction.xlsx"
If Dir(fichier1) = "" Then MsgBox fichier1 & " introuvable !": Exit Sub
If Dir(fichier2) = "" Then MsgBox fichier2 & " introuvable !": Exit Sub
Application.ScreenUpdating = False
Workbooks.Open fichier1 'ouverture du 1er fichier
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Set c = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
If c Is Nothing Then Set c = [A2] Else Set c = Cells(c.Row + 1, 1)
Workbooks.Open fichier2 'ouverture du 2ème fichier
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille...
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Anto,
Un essai en PJ avec :
VB: 
Sub Extraction()
Dim Wkb, Tablo, DL
Application.ScreenUpdating = False
Set Wkb = GetObject(ThisWorkbook.Path & "\Extraction.xlsx") ' Si les 2 fichiers sont dans le même dossier
Tablo = Wkb.Sheets("Sheet").[A1].CurrentRegion              ' Transfert de la plage à copier dans tableau
ActiveSheet.ShowAllData                                     ' Suppression des filtres
DL = 1 + Range("A65500").End(xlUp).Row                      ' Ligne où écrire
Cells(DL, "A").Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo   ' Transfert du tableau
Rows(DL).Delete Shift:=xlUp                                 ' Supppression ligne des titres
Wkb.Close SaveChanges:=False                                ' Fermeture fichier de lecture
End Sub
 

Pièces jointes

  • BD.xlsm
    17.8 KB · Affichages: 4
Dernière édition:
Vote positif 1 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Il eût été plus sain de continuer sur ce post.
Car sur mon PC ça marche :
Test2.gif

Là où un bug peut se produire c'est si aucun filtre n'est en place, dans ce cas il faut supprimer la ligne :
ActiveSheet.ShowAllData

Dans votre cas où est ce que cela buggue ?
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bon supprimer les doublons ne vous intéresse probablement pas.

Puisque les données du fichier "Extraction" sont déjà dans le fichier "BD".

Alors vous pouvez utiliser cette macro :
VB: 
Sub Copier()
Dim fichier$, c As Range
fichier = ThisWorkbook.Path & "\Extraction.xlsx"
If Dir(fichier) = "" Then MsgBox fichier & " introuvable !": Exit Sub
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Set c = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
If c Is Nothing Then Set c = [A2] Else Set c = Cells(c.Row + 1, 1)
Workbooks.Open fichier
ActiveSheet.UsedRange.Offset(1).Copy c
ActiveWorkbook.Close False
End Sub
 

Pièces jointes

  • BD.xlsm
    19.4 KB · Affichages: 0
  • Extraction.xlsx
    9.8 KB · Affichages: 1
Vote positif 0 Vote négatif
A

Anto35200

XLDnaute Occasionnel
Bonjour Sylvanu,

Effectivement, en supprimant la ligne ActiveSheet.ShowAllData, çà fonctionne.
Comment je peux lancer cette macro depuis un autre fichier ?
C'est-à-dire, il y aura un fichier avec la macro qui copiera les données du fichier Extraction dans le fichier BD.
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Anto,
Si je comprend bien, il y a un "FichierMaitre" qui a une macro.
Cette macro prend les données du fichier Extraction, les écrit dans BD, et sort. C'est bien ça ?
Si oui, essayez cette PJ :
VB: 
Sub Extraction()
Dim Wkb, Tablo, DL
Application.ScreenUpdating = False
' Copie des données du fichier source
Set Wkb1 = GetObject(ThisWorkbook.Path & "\Extraction.xlsx") ' Si les 2 fichiers sont dans le même dossier
Tablo = Wkb1.Sheets("Sheet").[A1].CurrentRegion              ' Transfert de la plage à copier dans tableau
Wkb1.Close SaveChanges:=False                                ' Fermeture fichier de lecture
' Ecriture dans fichier destination
Workbooks.Open ThisWorkbook.Path & "\BD.xlsx"               ' Ouverture fichier pour écriture
With Sheets("Sheet")
    If .FilterMode Then .ShowAllData                        ' Suppression des filtres
    DL = 1 + .Range("A65500").End(xlUp).Row                 ' Ligne où écrire
    .Cells(DL, "A").Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo   ' Transfert du tableau
    .Rows(DL).Delete Shift:=xlUp                            ' Supppression ligne des titres
End With
ActiveWorkbook.Save                                         ' Sauvegarde
ActiveWorkbook.Close                                        ' Fermeture , à supprimer si on veut garder le fichier ouvert
' A supprimer, juste pour test
[C8] = "Nombre de lignes copiées :":    [D8] = UBound(Tablo) - 1
[C9] = "Nombre de lignes BD avant :":   [D9] = DL - 1
[C10] = "Nombre de lignes BD après :":  [D10] = [D8] + [D9]
End Sub
La fin est juste pour le test. Inutile et peut être supprimée.
La ligne "ActiveWorkbook.Close" est à supprimer si vous voulez garder le fichier BD ouvert à la fin.
A noter, comme le dit Job, que la macro copiera à chaque fois qu'on clique sur le bouton. Question : Doit on supprimer les doublons ou certaines lignes peuvent être "naturellement" doublonnées ?
 

Pièces jointes

  • FichierMaitre.xlsm
    17.9 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour,

On me snobe mais je m'en fiche :
VB: 
Sub Copier()
Dim fichier1$, fichier2$, c As Range
fichier1 = ThisWorkbook.Path & "\BD.xlsx"
fichier2 = ThisWorkbook.Path & "\Extraction.xlsx"
If Dir(fichier1) = "" Then MsgBox fichier1 & " introuvable !": Exit Sub
If Dir(fichier2) = "" Then MsgBox fichier2 & " introuvable !": Exit Sub
Application.ScreenUpdating = False
Workbooks.Open fichier1 'ouverture du 1er fichier
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Set c = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
If c Is Nothing Then Set c = [A2] Else Set c = Cells(c.Row + 1, 1)
Workbooks.Open fichier2 'ouverture du 2ème fichier
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
ActiveSheet.UsedRange.Offset(1).Copy c 'copier-coller
ActiveWorkbook.Close False 'fermeture du 2ème fichier
c.Parent.Parent.Close True 'fermeture du 1er fichier après enregistrement
MsgBox Dir(fichier2) & " a été copié vers " & Dir(fichier1)
End Sub
A+
 

Pièces jointes

  • Fichier pilote.xlsm
    19.6 KB · Affichages: 1
  • BD.xlsx
    11.1 KB · Affichages: 0
  • Extraction.xlsx
    9.8 KB · Affichages: 0
Vote positif 0 Vote négatif
Solution
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Job,
job75 à dit:
On me snobe mais je m'en fiche
Cliquez pour agrandir...
Je ne pense pas, mais Anto a une façon bien particulière de communiquer.
Il pose une question, il a une réponse (boguée) donc il s'en va sans même répondre avant qu'on lui pose la question et refait un post. (Lien) qui n'aboutit pas non plus.
Alors il revient ici, repose une question sans même avoir lu vos propositions.
Peut être finira t-il par converger. :)
 
Vote positif 1 Vote négatif

Discussions similaires

A
  • Résolu(e)
XL 2016 Selectionner plages de cellule
Réponses
3
Affichages
79
gbinforme
G
A
  • Résolu(e)
XL 2016 VBA pour sélectionner une plage de cellule à la dernière cellule vide
Réponses
2
Affichages
395
Anto35200
A
A
  • Résolu(e)
XL 2016 VBA dernière cellule vide.
2
Réponses
21
Affichages
988
mapomme
mapomme
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
333
gwenn49
G
MCenpls
  • Résolu(e)
Microsoft 365 Automatisation - Copier coller
Réponses
6
Affichages
336
MCenpls
MCenpls
L
  • Question
XL 2016 Création d'une étiquette CB avec Excel
Réponses
5
Affichages
200
lincoln75
L
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
177
sylvanu
sylvanu
Usine à gaz
  • Question
XL 2021 Formule compter les cellules vides lusqu'à la dernière ligne NON vide
Réponses
10
Affichages
277
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
XL 2021 Sélectionner plusieurs plages jusqu'à la dernière ligne NON vide en col "E"
Réponses
5
Affichages
65
Usine à gaz
Usine à gaz
Sellig
  • Question
XL 2019 Insertion de plusieurs lignes au dessus de la dernière
Réponses
2
Affichages
278
Sellig
Sellig

Membres actuellement en ligne

5 membres et 60 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin