Macro fusion BDD avec sélection du fichier à copier
Bonjour,
Je souhaite créer une macro qui, à partir du classeur ouvert, va :
- afficher l'option parcourir pour aller chercher le chemin vers un autre fichier, qui est toujours présenté de la même façon
- déterminer la dernière ligne du fichier en question
- déterminer la dernière ligne vide du tableau actif
- copier les valeurs de plusieurs colonnes, sans compter les étiquettes de la première ligne
- insérer les cellules copiées dans le tableau actif
J'ai essayé de faire le code suivant :
Sub fusion()
Dim chemin As String 'nom de variable récupérant le chemin du fichier
Dim ligneVide As Long 'Récupère la dernière ligne vide en partant de la fin du classeur original
Dim derniereLigne As Long 'Récupère la dernière ligne du classeur à copier
chemin = Application.GetOpenFilename 'Récupère le chemin du fichier où copier les données
derniereLigne = Workbooks("chemin").Worksheets(1).Range("A2" & Rows.Count).End(xlUp).Row 'trouve la dernière ligne du classeur à copier
ligneVide = Range("A" & Rows.Count).End(xlUp).Row + 1 'Trouve la bonne ligne où insérer les données copiées
Workbooks("chemin").Worksheets(1).Range("A2:D" & derniereLigne).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("D" & ligneVide) 'Copie les valeurs
Workbooks("chemin").Worksheets(1).Range("H2:L" & derniereLigne).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("I" & ligneVide)
Workbooks("chemin").Worksheets(1).Range("O2:O" & ligneVide).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("N" & ligneVide)
Workbooks("chemin").Worksheets(1).Range("M2:M" & ligneVide).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("P" & ligneVide)
Workbooks("chemin").Worksheets(1).Range("N2:N" & ligneVide).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("O" & ligneVide)
End Sub
Mais ça bloque à la première ligne de copie:
Workbooks("chemin").Worksheets(1).Range("A2:D" & derniereLigne).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("D" & ligneVide) 'Copie les valeurs
Quelqu'un comprends le problème ?
J'ai mis le fichier test où je souhaite importer les données, et test2 sur lequel je souhaite récupérer les données.
Merci de votre aide,
Julien
EDIT : J'avais oublié de déterminer la variable derniereLigne, mais toujours le même problème : Erreur d'éxecution 9, l'indice n'appartient pas à la sélection.
Bonjour,
Un essai ...
Sub fusion()
Dim Chemin As String 'nom de variable récupérant le chemin du fichier
Dim LigneVide As Long 'Récupère la dernière ligne vide en partant de la fin du classeur original
Dim DerniereLigne As Long 'Récupère la dernière ligne du classeur à copier
Dim FichierOuvert As Workbook
LigneVide = Range("A" & Rows.Count).End(xlUp).Row + 1 'Trouve la bonne ligne où insérer les données copiées
Chemin = Application.GetOpenFilename("excel files (*.xlsx),*.xlsm") 'Récupère le chemin du fichier où copier les données
Set FichierOuvert = Application.Workbooks.Open(Chemin)
DerniereLigne = FichierOuvert.Worksheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row 'trouve la dernière ligne du classeur à copier
FichierOuvert.Worksheets(1).Range("A2:D" & DerniereLigne).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("D" & LigneVide) 'Copie les valeurs
FichierOuvert.Worksheets(1).Range("H2:L" & DerniereLigne).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("I" & LigneVide)
FichierOuvert.Worksheets(1).Range("O2:O" & LigneVide).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("N" & LigneVide)
FichierOuvert.Worksheets(1).Range("M2:M" & LigneVide).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("P" & LigneVide)
FichierOuvert.Worksheets(1).Range("N2:N" & LigneVide).Copy _
Destination:=ActiveWorkbook.ActiveSheet.Range("O" & LigneVide)
FichierOuvert.Close False
End Sub
ric
Bonjour et merci de votre réponse.
ça fonctionne quasiment, tout est copié, mais vue que le classeur Test2 s'ouvre, c'est lui qui devient le classeur actif et du coup tout est copié dans ce classeur, alors que je souhaite copier les infos dans Test.xlsm
J'ai essayé en définissant des variables pour le nom du classeur et de la feuille, mais il m'indique qualificateur incorrect :
Sub fusion()
Dim Chemin As String 'nom de variable récupérant le chemin du fichier
Dim LigneVide As Long 'Récupère la dernière ligne vide en partant de la fin du classeur original
Dim DerniereLigne As Long 'Récupère la dernière ligne du classeur à copier
Dim FichierOuvert As Workbook 'permets d'ouvrir le fichier à copier
Dim NomFichier As String 'Récupère le nom du fichier où copier
Dim NomFeuille As String 'Récupère le nom de la feuille où copier
NomFichier = ActiveWorkbook.Name 'définit le nom du fichier où copier
NomFeuille = ActiveSheet.Name 'Définit le nom de la feuille où copier
LigneVide = Range("A" & Rows.Count).End(xlUp).Row + 1 'Trouve la bonne ligne où insérer les données copiées
Chemin = Application.GetOpenFilename("excel files (*.xlsx),*.xls") 'Récupère le chemin du fichier où copier les données
Range("a1") = NomFichier
Set FichierOuvert = Application.Workbooks.Open(Chemin) 'Ouvre le fichier à copier
DerniereLigne = FichierOuvert.Worksheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row 'trouve la dernière ligne du classeur à copier
FichierOuvert.Worksheets(1).Range("A2:D" & DerniereLigne).Copy _
Destination:=NomFichier.NomFeuille.Range("D" & LigneVide) 'Copie les valeurs
FichierOuvert.Worksheets(1).Range("H2:L" & DerniereLigne).Copy _
Destination:=NomFichier.NomFeuille.Range("I" & LigneVide)
FichierOuvert.Worksheets(1).Range("O2:O" & DerniereLigne).Copy _
Destination:=NomFichier.NomFeuille.Range("N" & LigneVide)
FichierOuvert.Worksheets(1).Range("M2:M" & DerniereLigne).Copy _
Destination:=NomFichier.NomFeuille.Range("P" & LigneVide)
FichierOuvert.Worksheets(1).Range("N2:N" & DerniereLigne).Copy _
Destination:=NomFichier.NomFeuille.Range("O" & LigneVide)
FichierOuvert.Close False 'Ferme le classeur à copier
End Sub
Merci de votre aide.
Julien
Bonjour
II est surprenant que tu n'utilises pas un tableau structuré pour ta BDD.
Outre tous les avantages pour l'exploitation, le VBA serait simplifié
Ah, et bien justement, j'en utilise un, mais je ne savais pas que le vba serait modifié ^^
RE
C'est la source ou la cible qui est sous forme de tableau ?
Sans fichier représentatif...
A noter que
Range("a1") = NomFichier
n'indique ni le classeur, ni la feuille concernés : le bon moyen de mettre le souk
Woups oui le range a1 c'était pour faire un test, il n'est plus dans la macro ^^
C'est la cible, le fichier de base, par contre les fichiers que je dois importer dedans ne sont pas sous forme de tableaux.
Bonjour
Sub fusion()
Dim Chemin As String 'nom de variable récupérant le chemin du fichier
Dim DerniereLigne As Long 'Récupère la dernière ligne du classeur à copier
Dim FichierOuvert As Workbook 'permets d'ouvrir le fichier à copier
Dim LigneVide As Long 'Récupère la ligne sous le tableau du classeur original
Dim TableauCible As ListObject
Set TableauCible = [TableauTest].ListObject
With TableauCible
Chemin = Application.GetOpenFilename("excel files (*.xlsx),*.xls*") 'Récupère le chemin du fichier où copier les données
Set FichierOuvert = Application.Workbooks.Open(Chemin) 'Ouvre le fichier à copier
DerniereLigne = FichierOuvert.Worksheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row 'trouve la dernière ligne du classeur à copier
LigneVide = .Range.Rows.Count - .Range.Row + 1 'Trouve la bonne ligne où insérer les données copiées
FichierOuvert.Worksheets(1).Range("A2:D" & DerniereLigne).Copy _
Destination:=.DataBodyRange.Cells(LigneVide, 4) 'Copie les valeurs
FichierOuvert.Worksheets(1).Range("H2:L" & DerniereLigne).Copy _
Destination:=.DataBodyRange.Cells(LigneVide, 9)
FichierOuvert.Worksheets(1).Range("O2:O" & DerniereLigne).Copy _
Destination:=.DataBodyRange.Cells(LigneVide, 14)
FichierOuvert.Worksheets(1).Range("M2:M" & DerniereLigne).Copy _
Destination:=.DataBodyRange.Cells(LigneVide, 16)
FichierOuvert.Worksheets(1).Range("N2:N" & DerniereLigne).Copy _
Destination:=.DataBodyRange.Cells(LigneVide, 15)
FichierOuvert.Close False 'Ferme le classeur à copier
End With
End Sub
Super merci, ça marche parfaitement, effectivement c'est plus simple avec un tableau structuré, tout se rajoute à la fin du tableau.