Import de fichier excel grâce à VBA

aba2s

XLDnaute Junior
Bonjour la communauté,
Je souhaiterai importer un fichier excel grâce une macro VBA Le même fichier sera importé tous les jours. Mon souci est que le fichier importé n'écrase pas les anciennes données déjà importées. Je souhaite quà chaque importation la macro ajoute les données importées sans écraser les anciennes mais les ajoutes en dessous.

Merci beaucoup pour votre aide!
 

Pièces jointes

  • Data.xlsx
    32.4 KB · Affichages: 10

aba2s

XLDnaute Junior
Hello les amoureux de la programmation!
Pourriez-vous svp m'aider ici.?Je n'arrive à importer mes données sans écraser les anciennes.
J'ai deux classeurs : un à importer et l'autre c'est celui qui doit recevoir les données importées.
Ci-joint les deux classeurs.


VB:
Sub Importation_SourceDato()

Dim FichierDato, Template As String
FichierDato = Application.GetOpenFilename("Fichier Excel (*.xlsx), *.xlsx", , _
              "Choisissez votre fichier Dato !")

If FichierDato = "Faux" Then
    MsgBox "@Data Tech : Vous souhaitez annulé?"
    End
End If
Template = ActiveWorkbook.Name 'Notre template de reporting
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Source").Activate
ActiveSheet.Cells.Select
Selection.Clear
On Error GoTo 0

Application.ScreenUpdating = False
    'Transfert par Copier/coller
    Application.DisplayAlerts = True
    Workbooks.Open Filename:=FichierDato, ReadOnly:=True
    NomFichierOuvert = ActiveWorkbook.Name
    Set entete = ActiveSheet.Cells.Find(what:="Vendor Name") 'A adapter
    If entete Is Nothing Then
      ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count).CurrentRegion.Copy
    Else
       ActiveSheet.Range(Cells(entete.Row + 1, entete.Column), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Copy
    End If
    Workbooks(Template).Activate
    ActiveWorkbook.Sheets("Destination").Activate
    ActiveSheet.Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
      
    Application.DisplayAlerts = False
    Workbooks(NomFichierOuvert).Close
    Application.DisplayAlerts = True
  
  
    End Sub
 

Pièces jointes

  • Fichier à importer.xlsx
    29.9 KB · Affichages: 14
  • Fichier Destination.xlsm
    18.4 KB · Affichages: 15
Dernière édition:

zebanx

XLDnaute Accro
Bonjour Aba2s

Un essai

Deux remarques :
1. Je n'ai pas compris pourquoi il y avait un selection.clear en début de code et l'ai neutralisé pour l'exécution du code modifié (mais la ligne n'est évidemment pas supprimé)
2. Pour conserver les données précédentes, on ne pouvait pas coller en cellule "I2" sur le fichier de destination mais sur la ligne suivante la dernière ligne remplie sur la colonne "I".

En espérant que cela vous permette de finaliser votre projet.
xl-ment
zebanx

VB:
Sub Importation_SourceDato()

Dim FichierDato, Template As String
FichierDato = Application.GetOpenFilename("Fichier Excel (*.xlsx), *.xlsx", , _
              "Choisissez votre fichier Dato !")

If FichierDato = "Faux" Then
    MsgBox "@Data Tech : Vous souhaitez annulé?"
    End
End If
Template = ActiveWorkbook.Name 'Notre template de reporting
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Source").Activate
ActiveSheet.Cells.Select
'Selection.Clear '--- pourquoi ???
On Error GoTo 0

Application.ScreenUpdating = False
    'Transfert par Copier/coller
    Application.DisplayAlerts = True
    Workbooks.Open Filename:=FichierDato, ReadOnly:=True
    NomFichierOuvert = ActiveWorkbook.Name
    'Set entete = ActiveSheet.Cells.Find(what:="Vendor Name") 'A adapter
    Set entete = ActiveSheet.Cells.Find(what:="Date") 'modifié
    If entete Is Nothing Then
      ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count).CurrentRegion.Copy
    Else
       ActiveSheet.Range(Cells(entete.Row + 1, entete.Column), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Copy
    End If
    Workbooks(Template).Activate
    ActiveWorkbook.Sheets("Destination").Activate
    ActiveSheet.Range("I" & Cells(Rows.Count, "i").End(3)(2).Row).Select '--- modifié
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
       
    Application.DisplayAlerts = False
    Workbooks(NomFichierOuvert).Close
    Application.DisplayAlerts = True
   
   
    End Sub
 

Pièces jointes

  • Fichier à importer.xlsx
    31.4 KB · Affichages: 27
  • Fichier Destination.xlsm
    19 KB · Affichages: 28

aba2s

XLDnaute Junior
Bonjour @zebanx ,
Merci beaucoup pour ton aide!
Ton code marche correctement par contre je ne comprends qu'est tu veux dire par end(3)(2) dans la ligne suivante
Range("I" & Cells(Rows.Count, "i").End(3)(2).Row).Select

A quoi correspond les chiffres 2 et 3?
D'habitude j'utilise end(xlUP)

Merci beaucoup d'avance
 

zebanx

XLDnaute Accro
Re

end(3)(2)

(3) : xlup
en fait, juste derrière le "end" : (1) correspond à left, (2) à right, (3) à up et (4) à down

(2)
indique la ligne recherchée.
soit (0) la ligne au-dessus, (1) la même ligne et (2) la ligne en-dessous

On a donc end(3)(2) qui va chercher la ligne "up" mais va aller finalement se caler juste en-dessous (comme un offset(1,0)).

Des petits raccourcis qu'on apprend sur le forum... au fur et à mesure.;)

@+
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 909
Membres
101 836
dernier inscrit
karmon