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

9test.xlsm (20.46 Ko)
4test2.xlsx (12.02 Ko)

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é

https://fauconnier.developpez.com/tutoriels/tableaux-structures/

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.

2test.xlsm (22.04 Ko)

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.

Rechercher des sujets similaires à "macro fusion bdd selection fichier copier"