XL 2013 INTEGRER NOUVELLES LIGNES D'UN FICHIER A UNE BASE

[CARO13]

Bonjour

J'ai un fichier qui me permet de suivre différentes commandes.

dans ce fichier j'ai un onglet Base où je garde l'historique et mets à jour que certaines informations.
Tous les jours je reçois un fichier qui m'indique les modifications des lignes existantes et également les nouvelles commandes (New)que je dois intégrer dans ma base

Actuellement j'ai une macro qui copie/colle la totalité du fichier "New" et dédoublonne pour ajouter les nouvelles lignes.

Cette manip a ses limites et la macro tourne durant plus d'1/2 heure car plus de 2000 lignes

je ne peux malheureusement pas mettre le fichier dans sa globalité car ce sont des données confidentiel

Pouvez vous m'aider a trouver une macro qui permet d'intégrer que les nouvelles lignes

Merci pour votre aide

 

[Robert]

Bonjour Caro, bonjour le forum,

Créer un fichier anonymiser reprenant la structure de ton fichier original ne demande pas tant d'effort que ça ! En tous cas, moins que de te répondre sur du vide...
La cale est dans ton banc... Voire même, la balle est dans ton camp.

 

[CARO13]

C'est vrai
je fais ca !

 

[CARO13]

Voilà le fichier avec la macro actuelle
Merci pour votre aide

 

[Robert]

Bonjour Caro, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous (j'espère avoir compris et respecté le tien) :

Sub INSERSION_NEW_FICHIER_AS()
Dim S As Worksheet 'déclare la variable S (onglet SOMMAIRE)
Dim BA As Worksheet 'déclare la variable BA (onglet BASE AS)
Dim NA As Worksheet 'déclare la variable NA (onglet NEW AS)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim PAS As Range 'déclare la variable PAS (Plage À Supprimer)
Dim R As Range 'déclare la variable R (Recherche)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set S = Worksheets("SOMMAIRE") 'définit l'onglet S
Set BA = Worksheets("BASE AS") 'définit l'onglet BA
Set NA = Worksheets("NEW AS") 'définit l'onglet NA
If BA.FilterMode = True Then BA.ShowAllData 'supprime les filtre de l'onglet BA
DL = BA.Cells(Application.Rows.Count, "B").End(xlUp).Row 'definit la dernière ligne éditée DL de la colonne B de l'onglet BA
Set PL = NA.Range("A1").CurrentRegion 'définit la plage PL
Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
Set DEST = BA.Cells(DL + 1, "B") 'définit la cellule de destination DEST
PL.Copy 'copie la plage PL
DEST.PasteSpecial (xlPasteValues) 'colle les valeurs dans DEST
Set PAS = Range("A1") 'initialise la plage à supprimer PAS
TV = BA.Range("A1:R" & DL) 'de'finit le tableau des valeurs TV
For I = 4 To DL 'boucle des lignes 4 a DL
    'condition : si le nombre de fois que la donnée ligne I colonne 2 de TV apparait dans la colonne B de l'onglet AB est supérieur à 1
    If Application.WorksheetFunction.CountIf(BA.Columns(2), TV(I, 2)) > 1 Then
        Set R = BA.Columns(2).Find(TV(I, 2), BA.Cells(I, "B"), xlValues, xlWhole) 'définit la recherche R (recherche la valeur entière de TV(I,2) dans la colonne B de l'onglet BA)
        If PAS.Cells.Count = 1 Then Set PAS = BA.Rows(R.Row) Else Set PAS = Application.Union(PAS, BA.Rows(R.Row)) 'redéfinit la plage PAS
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
PAS.Delete 'supprime la plage PAS
DL = BA.Cells(Application.Rows.Count, "B").End(xlUp).Row 'redefinit la dernière ligne éditée DL de la colonne B de l'onglet BA
BA.Range("D4").FormulaR1C1 = _
    "=IFERROR(INDEX('NEW AS'!C1:C16,RC1,R1C),""Fermé"")" 'formule en D4
BA.Range("D4").AutoFill Destination:=BA.Range("D4:D5000") 'glissement de la formule jusqu'en D5000
BA.Range("R4").FormulaR1C1 = _
    "=IFERROR(INDEX('NEW AS'!C1:C16,RC1,R1C),""Fermé"")" 'formule en R4
BA.Range("R4").AutoFill Destination:=BA.Range("R4:R" & DL) 'glissement de la formule jusqu'en R5000
'ton code que je n'ai pas compris
BA.Select
With Range("A" & Rows.Count).End(xlUp).EntireRow
    .Copy .Rows(2).Resize(5000 - .Row)
End With
BA.Range("A1").Select
S.Activate
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
res_test = Format(Timer - TEST, "0" & Application.DecimalSeparator & "000") 'calcul du temps
MsgBox "Le traitement est terminé. " & res_test 'message
End Sub

Le fichier :

 

[CARO13]

Merci beaucoup
je teste ca et reviens vers toi !

 

[CARO13]

Bonjour
un enorme merci, je viens de finaliser toutes mes maj et c'est parfait !!! ca fonctionne parfaitement