Discussion :

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
 
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