Import de fichier excel grâce à VBA

[aba2s]

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!

 

[aba2s]

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.

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

 

[zebanx]

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

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

 

[aba2s]

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]

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.😉

@+

 

[aba2s]

@zebanx Merci beaucoup. C'est top et très clair. Merci pour le partage