XL 2016 Lignes pas mise à jour lors d'une exécution macro

[Fabien62]

Bonjour à tous,

Je rencontre un petit souci lors de l'exécution d'un macro qui récupère des données dans un fichier BDD (base de données), mon souci est que si j'ajoute des lignes aucun problème tout est parfait, mais si j'en supprime dans le fichier BDD, le fichier destinataire se retrouve avec des anciennes lignes.

EX : le fichier BDD contient 100 ligne remplies dans les colonnes A à G et que le fichier destinataire en contient déjà 150, je me retrouve avec 50 lignes non mise à jour.

Le but serait de réaliser un effacement du contenu (pas de suppression) des lignes remplies de A à G

Ci-dessous la macro :

Sub récup_données()

Dim Wb As Workbook
Dim Wkb As Workbook
Dim rep As String, Nom_fic(20) As String
Application.ScreenUpdating = False
'Call remiseàblanc
'Récup Liste des fichiers
rep = "C:\Users\Fives\Desktop\Puce\BDD"
nom = ActiveWorkbook.Name
Direction = Dir(rep & "\*.xlsx")
nbfic = 0
While Direction > ""
nbfic = nbfic + 1
Nom_fic(nbfic) = Direction
'MsgBox Nom_fic(nbfic) & " = " & nbfic
Direction = Dir()
Wend
'Stop
'Ouverture
For X = 1 To nbfic
fg = Nom_fic(X)
If fg = nom Then GoTo suite
Dim cpt As Integer
On Error Resume Next
WOuvert = False
' Parcours des classeurs ouverts
For Each Wkb In Workbooks
If Wkb.Name = fg Then
WOuvert = True
cpt = 1
Exit For
End If
Next Wkb
If cpt = 1 Then cpt = 0: GoTo fin
chemin = rep & "\" & fg
If Left(fg, 5) <> "Datas" Then GoTo suite
Workbooks.Open chemin
fin:
Windows(fg).Activate
Sheets("Datas").Activate
derligne = Sheets("Datas").Range("A65536").End(xlUp).Row
dercol = 7
Range(Cells(1, 1), Cells(derligne, dercol)).Select
Selection.Copy
Windows(nom).Activate
Sheets("Datas").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(fg).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
suite:
Next X
'Stop
Application.DisplayAlerts = True
'Stop
Sheets("Facture").Activate

End Sub

Merci pour votre aide

Cordialement

 

[Fabien62]

J'ai simplement rajouté

[Feuil4].Range("A:G").Clear

Cela fonctionne, je cherchais compliqué là où ça ne l'es pas, si toutefois vous avez d'autres codes je suis preneur pour ma culture

Cdlt