Copier/coller automatiquement des données

Melanie_Mn

XLDnaute Nouveau
Bonjour à tous,

Je suis nouvelle sur ce forum et débutante dans Excel.

J'aurais besoin d'aide sur un sujet.

J'ai un classeur excel que je reçois chaque semaine avec des données (Classeur nommé ci-joint "Données fournisseurs")
J'ai un 2nd classeur que je traite chaque semaine (nommé ci-joint "Données retraitées")

J'ai tellement de données à retraiter que je voudrais si possible automatiser ceci. Je m'explique :

A chaque fois que je reçois un nouveau classeur "Données fournisseurs" je voudrais que les lignes contenant la marque "XAM" soient automatiquement copiées dans le classeur "Données retraitées" dans l'onglet "Détails"

Est-ce possible d'automatiser ceci ?

D'avance, merci pour votre aide.

Belle journée ensoleillée.

Mélanie
 

Pièces jointes

  • Données retraitées.xlsx
    7.7 KB · Affichages: 6
  • Données fournisseurs.xlsx
    9 KB · Affichages: 8

zebanx

XLDnaute Accro
Bonjour Melanie

Bienvenue sur le forum et merci pour votre présentation.

Un essai avec un getopenfile (on va chercher le fichier "données fournisseurs" dans un répertoire) qui va coper la zone filtrée (sur la première feuille) après la dernière ligne active de la feuille "détails".
Les données ne sont pas écrasées, elles sont compilées.

Le fichier contenant la macro est sur le fichier "Données retraitées". Ce fichier est enregistré en XLSM puisqu'il contient une macro.

VB:
Sub exporter_copie_getopen()
'--- on utilise un GETOPENFILE pour choisir le fichier qui se trouve dans un autre répertoire
Dim FichierAouvrir As Variant, a, classeur As Workbook, i
Dim derligne As Integer
Dim aw As Workbook

Set aw = ActiveWorkbook 

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")

If FichierAouvrir = False Then Exit Sub
If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
On Error Resume Next 'sécurité, si une feuille n'existe pas

Set classeur = Workbooks.Open(FichierAouvrir)
With classeur.Sheets(1)
[A:D].AutoFilter 1, "*" & "XAM" & "*" 'filtre automatique
Set P = classeur.Sheets(1).UsedRange.Offset(1, 0)
End With
  
P.copy aw.Sheets("Details").Cells(aw.Sheets("Details").Cells(Rows.Count, 1).End(3)(2).Row, 1)

classeur.Close False
aw.Sheets(2).Activate

End Sub

xl-ment
zebanx
 

Pièces jointes

  • Données retraitées.xlsm
    18.8 KB · Affichages: 8

Discussions similaires