Discussion :

[Sami_Xite]

Bonjour,

Nous recevons chaque jour un rapport Excel nommé "report.xlsx" dont je voudrais récupérer les nouveaux enregistrements dans un autre classeur "notif.xlsm"
Concrètement
- Je reçois le fichier report.xlsx et l'enregistre dans un répertoire dédié. Ce classeur contient tous les enregistrements créés antérieurement + les nouveaux enregistrements du jour
- J'ouvre le classeur "notif.xlsm" qui contient la totalité des lignes contenues dans le report de la veille et doit importer uniquement les nouvelles lignes

A noter que le report comprend un champs "ref" qui est unique j'avais donc pensé que la macro pourrait se baser sur cette valeur pour savoir quels enregistrements elle doit ajouter ou alors qu'elle efface complètement le classeur "notif" et réimporte la totalité du report.
On parle de 5000 enregistrements sur une année.
Total débutant en VBA j'ai bien tenté d'utiliser l'enregistreur de macro mais je suis loin du résultat attendu

Merci d'avance pour votre aide

[EricDgn]

Bonjour,

Travaillez sur quelque chose de ce genre:

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
Option Explicit
 
'--- suppose que les ref sont sans doublon et sont créées et conservées en ordre alphanumérique
Sub NewData()
    Dim sRef As String, rRef As Range, rNewRef As Range, kR As Long
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Select
    sRef = ActiveCell.Value             '--- la dernière référence
    Set rRef = ActiveCell.Offset(1, 0)  '--- cellule (vide) sous la dernière référence
 
    Windows("report.xlsx").Activate
    '--- suppose que l'on est sur la bonne feuille et que la colonne A contient les ref
    Set rNewRef = Columns(1).Find(What:=sRef, After:=Range("A1"), LookIn:=xlFormulas, _
                                  LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rNewRef Is Nothing Then
        MsgBox "La dernière référence n'a pas été retrouvée !?" & vbLf & _
               "Aucune nouvelle donnée ajoutée.", , "Anomalie!"
    Else
        kR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row  '--- n° dernière ligne
        If kR = rNewRef.Row Then
            MsgBox "La dernière référence est identique dans les 2 feuilles." & vbLf & _
                   "Aucune nouvelle donnée ajoutée.", , "Rien de neuf!"
        Else
            Rows(rNewRef.Row + 1 & ":" & kR).Copy rRef   '--- copie les lignes contenant les nouvelles ref
            Application.CutCopyMode = False
        End If
    End If
 
    Windows("notif.xlsm").Activate
End Sub

Cordialement.