robby98800
XLDnaute Nouveau
Bonjour le forum j'ai besoin de votre aide,
J'ai créé une macro qui me permet d'importer des données d'un classeur vers un autre. Le problème est que l'endroit où je colle mes données est un tableau et quand j'exécute de nouveau la macro, comme j'ai mis un clearcontents qui enlèvent les données de la macro précédente, les nouvelles données se classent dans des cellules "normales" et le tableau a disparu.
Si vous regardez le code, je colle en fait les données dans les 5 premières colonnes (A,B,C,D et E) à partir de la ligne 2. J'aimerais que le tableau soit composé des titre en première ligne (qui ne seront pas modifiés) et les autres lignes seront changés quand j'exécute la macro.
Voici le code :
Merci pour le coup de main !
J'ai créé une macro qui me permet d'importer des données d'un classeur vers un autre. Le problème est que l'endroit où je colle mes données est un tableau et quand j'exécute de nouveau la macro, comme j'ai mis un clearcontents qui enlèvent les données de la macro précédente, les nouvelles données se classent dans des cellules "normales" et le tableau a disparu.
Si vous regardez le code, je colle en fait les données dans les 5 premières colonnes (A,B,C,D et E) à partir de la ligne 2. J'aimerais que le tableau soit composé des titre en première ligne (qui ne seront pas modifiés) et les autres lignes seront changés quand j'exécute la macro.
Voici le code :
Code:
Sub Import()
Set Destination = ActiveWorkbook
Dim ladate As Date, Plage As Range
ladate = DateAdd("d", -7, Date)
Source = Application.Dialogs(xlDialogOpen).Show
If Source = False Then
MsgBox ("Aucun fichier sélectionné")
Exit Sub
Else
Set Source = ActiveWorkbook
Source.Activate
Sheets(1).Select
For I = 2 To Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
If Sheets(1).Range("A" & I).Value >= ladate Then
If Plage Is Nothing Then
Set Plage = Sheets(1).Range("A" & I & ":" & "E" & I)
Else
Set Plage = Union(Plage, Sheets(1).Range("A" & I & ":" & "E" & I))
End If
End If
Next
Destination.Activate
Sheets(2).Range("A" & ":" & "E").ClearContents
Plage.Copy Destination:=Sheets(2).Range("A2")
Source.Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
End If
End Sub
Merci pour le coup de main !