[RESOLU][VBA] Copier données d'un fichier vers dernière ligne d'un autre

W

Whivez

XLDnaute Nouveau
Bonjour,

En parcourant le forum, j'ai trouvé une macro correspondant que j'ai adapté à mon besoin, que voici:
Copier les données d'un fichier à (nom aléatoire) vers la dernière ligne d'un fichier base de données.

En gros:
Sélection du fichier "source" via message box
renommage de nom de feuille (pour facilité ma macro)
Sélection de la plage de données, c'est à dire de la ligne A5 jusqu'à la case vide
Copie
Collage dans le fichier base de données, dans l'onglet "bdd" dans la première case vide

Ma macro:
Code: 
Sub CopieColleWbk()
  Dim WbkS As Workbook  ' Classeur source
  Dim WbkD As Workbook  ' Classeur de Destination
  Dim Sht As Worksheet ' Feuille source
  Dim VPathFic As String
  
  ' Demander de choisir le classeur Source
  MsgBox "Merci de sélectionner le classeur source !"
  ' Choisir le fichier à ouvrir
  VPathFic = ChoixFichier()
  ' Si aucun fichier, alors sortir
  If VPathFic = "" Then Exit Sub
  ' Sinon ouvrir le classeur
  Workbooks.Open VPathFic
  ' Définir le classeur source
  Set WbkS = ActiveWorkbook
  ' Renommer la feuille
ActiveSheet.Name = "Feuil1"
  ' activation classeur destination
Windows("tableau de bord.xlsx").Activate
Sheets("Bdd").Select
  ' Définir le classeur de Destination
  Set WbkD = ActiveWorkbook
  ' Effectuer la copie / collage
    WbkS.Sheets(Feuil1).Range("A5:A" & [C65535].End(xlUp).Row).Copy Destination:=WbkD.Sheets(bdd).Range("A5:A" & [A65536].End(xlUp).Row + 1)
  ' Message de fin
  MsgBox "La copie du classeur source vers le calsseur de destination est terminée"
  ' effacer les variables objet
  Set Sht = Nothing
  Set WbkD = Nothing
  Set WbkS = Nothing
End Sub
Function ChoixFichier()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
  Set fd = Application.FileDialog(msoFileDialogOpen)
  With fd
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    Else
      ChoixFichier = ""
    End If
  End With
  Set fd = Nothing
End Function

J'ai cependant une erreur à la ligne:
Code: 
    WbkS.Sheets(Feuil1).Range("A5:A" & [C65535].End(xlUp).Row).Copy Destination:=WbkD.Sheets(bdd).Range("A5:A" & [A65536].End(xlUp).Row + 1)

Qu'es-ce qui ne va pas dans ma macro ?

Merci d'avance de votre aide
 
Dernière édition:
Trier par date Trier par votes
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : [VBA] Copier données d'un fichier vers dernière ligne d'un autre

Bonjour,

pour la dernière ligne d'un tcd :
Code: 
Dim s As String, l As Long
s = ActiveSheet.PivotTables(1).TableRange2.Address
s = Split(s, ":")(UBound(Split(s, ":")))
l = CLng(Split(s, "$")(UBound(Split(s, "$"))))

bonne soirée
@+
 
Vote positif 0 Vote négatif
W

Whivez

XLDnaute Nouveau
Re : [VBA] Copier données d'un fichier vers dernière ligne d'un autre

Bonjour,
Merci de ta réponse.
Malheureusement, je ne suis pas doué... Où dois-je collé ce code ?
la partie:
Code: 
Dim s As String, l As Long
En début de code pas de soucis.

Mais pour:
Code: 
  s = ActiveSheet.PivotTable(1).TableRange2.Address
s = Split(s, ":")(UBound(Split(s, ":")))
l = CLng(Split(s, "$")(UBound(Split(s, "$"))))
Je ne vois pas où le mettre sans que ça me génère l'erreur:
"Erreur 1004: Impossible de lire la propriété PivotTables de la classe WorkSheet."

Je suis désolé d'être aussi noobs ! :(
 
Vote positif 0 Vote négatif
W

Whivez

XLDnaute Nouveau
Re : [VBA] Copier données d'un fichier vers dernière ligne d'un autre

Voici mon code:
Code: 
Sub CopieColleWbk()
  Dim WbkS As Workbook  ' Classeur source
  Dim WbkD As Workbook  ' Classeur de Destination
  Dim Sht As Worksheet ' Feuille source
  Dim VPathFic As String
  Dim s As String, l As Long

  ' Demander de choisir le classeur Source
  MsgBox "Merci de sélectionner le classeur source"
  ' Choisir le fichier à ouvrir
  VPathFic = ChoixFichier()
  ' Si aucun fichier, alors sortir
  If VPathFic = "" Then Exit Sub
  ' Sinon ouvrir le classeur
  Workbooks.Open VPathFic
  ' Définir le classeur source
  Set WbkS = ActiveWorkbook
  ' Renommer la feuille
ActiveSheet.Name = "Feuil1"
  ' activation classeur destination
Windows("tableau de bord.xlsm").Activate
Sheets("Bdd").Select
  ' Définir le classeur de Destination
  Set WbkD = ActiveWorkbook
  ' Effectuer la copie / collage
[B]    s = ActiveSheet.PivotTable(1).TableRange2.Address
s = Split(s, ":")(UBound(Split(s, ":")))
l = CLng(Split(s, "$")(UBound(Split(s, "$"))))[/B]
    WbkS.Sheets("Feuil1").Range("A5:S" & WbkS.Sheets("Feuil1").[A65535].End(xlUp).Row).Copy Destination:=WbkD.Sheets("bdd").[A65536].End(xlUp)(2)
  MsgBox "La copie du classeur source vers le calsseur de destination est terminée"
  ' effacer les variables objet
  Set Sht = Nothing
  Set WbkD = Nothing
  Set WbkS = Nothing
End Sub
Function ChoixFichier()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
  Set fd = Application.FileDialog(msoFileDialogOpen)
  With fd
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    Else
      ChoixFichier = ""
    End If
  End With
  Set fd = Nothing
End Function

Je l'ia un peu coller au hasard... Je ne vois pas trop comment m'en servir...
 
Dernière édition:
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : [VBA] Copier données d'un fichier vers dernière ligne d'un autre

Re,

Je l'ia un peu coller au hasard... Je ne vois pas trop comment m'en servir...
Cliquez pour agrandir...
bah... en vba, préférable de comprendre les codes que l'on utilise.... ce forum n'a pas vocation à livrer des applis clés en mains...

peut être modifier ceci :
Code: 
 WbkS.Sheets("Feuil1").Range("A5:S" & WbkS.Sheets("Feuil1").[A65535].End(xlUp).Row).Copy
par cela :
Code: 
 WbkS.Sheets("Feuil1").Range("A5:S" & l).Copy
 
Vote positif 0 Vote négatif
W

Whivez

XLDnaute Nouveau
Re : [VBA] Copier données d'un fichier vers dernière ligne d'un autre

Bon en cherchant et en trifouillant j'ai fini par tomber sur ça:
Code: 
Dim i As Integer
i = 1
While (Cells(i, 1).Value <> "")
i = i + 1
Wend

Et ça fonctionne nickel !

Le code final:
Code: 
Sub CopieColleWbk()
  Dim WbkS As Workbook  ' Classeur source
  Dim VPathFic As String
  Dim i As Integer
  
  ' Demander de choisir le classeur Source
  MsgBox "Merci de sélectionner le Fichier de données"
  ' Choisir le fichier à ouvrir
  VPathFic = ChoixFichier()
  ' Si aucun fichier, alors sortir
  If VPathFic = "" Then Exit Sub
  ' Sinon ouvrir le classeur
  Workbooks.Open VPathFic
  ' Définir le classeur source
  Set WbkS = ActiveWorkbook
  ' Renommer la feuille
ActiveSheet.Name = "Feuil1"
  ' Sélection et copie de plage données + 1 ligne vide
Range("A5:S" & WbkS.Sheets("Feuil1").[A65535].End(xlUp).Row + 1).Select
Selection.Copy
  ' activation classeur destination
Windows("tableau de bord.xlsm").Activate
  ' Sélection feuille
Sheets("Bdd").Activate
  ' Trouver dernière cellule vide du tableau
i = 1
While (Cells(i, 1).Value <> "")
i = i + 1
Wend
Cells(i, 1).Select
  ' Collage
ActiveSheet.Paste
  ' Message de fin
   MsgBox "La copie du classeur source vers le calsseur de destination est terminée"
End Sub
Function ChoixFichier()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
  Set fd = Application.FileDialog(msoFileDialogOpen)
  With fd
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    Else
      ChoixFichier = ""
    End If
  End With
  Set fd = Nothing
End Function

En tout les cas, merci Pierrot93 pour ton temps et ta patience, ça m'a permis d'avancer sur mon travail :)
 
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
XL 2016 Macro chargement liste arborescence, copier coller fichiers
Réponses
9
Affichages
380
Nermal64
N
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
535
Felipe54
F
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
95
Phil69970
Phil69970
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
1 K
Hutchy33
H
medlight
  • Question
Autres Transfert des données d'un classeur à un autre
Réponses
5
Affichages
266
Oneida
Oneida
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
162
sylvanu
sylvanu
Y
  • Question
XL 2019 copier/coller colonne vers ligne
Réponses
4
Affichages
249
sylvanu
sylvanu
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
128
marie3107
M
M
  • Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
110
Maxou69
M
L
  • Question
Microsoft 365 vba Outlook traiter un fichier excel lors de sa reception
Réponses
0
Affichages
250
lesoldat9
L

Membres actuellement en ligne

3 membres et 55 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 104
Messages
2 085 349
Membres
102 869
dernier inscrit
radyreth