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: 5
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: 2
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: 3
  • BD.xlsx
    11.1 KB · Affichages: 2
  • Extraction.xlsx
    9.8 KB · Affichages: 2
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
239
gbinforme
G
A
  • Résolu(e)
XL 2019 VBA - Copie données selon 3 critères
Réponses
4
Affichages
259
abouilies
A
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
677
Pac41240
P
S
  • Question
XL 2016 Transposer colonnes sur lignes
2 3
Réponses
32
Affichages
1 K
soumus
S
J
  • Résolu(e)
Microsoft 365 [RESOLU] VBA boucle, insertion plusieurs lignes, exécution formules, suppression sur si
Réponses
5
Affichages
429
Phil69970
Phil69970
A
  • Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
153
Anthony_51
A
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
155
AlCapone
AlCapone
V
  • Question
XL 2016 suivi temps
Réponses
2
Affichages
328
vivi21
V
A
  • Résolu(e)
Microsoft 365 Copier lien fichier avec VBA
Réponses
1
Affichages
290
vgendron
vgendron
T
  • Résolu(e)
XL 2016 Modification de données en fonction d'une valeur
Réponses
3
Affichages
386
therse
T

Membres actuellement en ligne

2 membres et 41 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
315 087
Messages
2 116 082
Membres
112 654
dernier inscrit
SADIKA