Copier les lignes d'un tableau avec conditions dans un nouveau fichier

ymonte

XLDnaute Nouveau
Bonjour,

je souhaite scinder un tableau de données sur x fichiers excel via une macro.

j'ai donc un fichier excel reprenant des tarifs d'achats par fournisseurs. L'objectif est de créer un fichier Excel par fournisseurs avec l'ensemble des tarifs qui le concerne.

Dans un premier temps, je dois :

- créer un fichier Excel par fournisseur (ce qui fera au final 200 fournisseurs donc 200 fichiers) avec la même en-tête que le fichier d'origine
- Nommer ce fichier du nom du fournisseur.
- L'enregistrer dans un dossier
- ajouter les lignes de tarifs qui le concerne

La macro doit faire une boucle pour permettre de recréer un nouveau fichier à chaque changement de nom de fournisseur dans le tableau d'origine. Le nom du fournisseur est toujours dans la même colonne.

Je suis novice dans les macros et après de multiples recherches sur tous les forums, j'en ai déduit qu'il faut utiliser une fonction copy pour l'en-tête et pour les lignes mais je suis incapable de créer le code.

Quelqu'un peut-il me venir en aide sinon je serai obliger de consacrer une journée à faire des copier-coller.

A l'aide;

Merci d'avance

PS : je joins le fichier pour exemple avec le résultat souhaité mais pas dans un classeur mais sur un fichier à part.
 

Pièces jointes

  • MATRICE TARIF ACHATS.xlsx
    16 KB · Affichages: 25
  • RESULTAT SOUHAITE.xlsx
    20.2 KB · Affichages: 26
  • RESULTAT SOUHAITE.xlsx
    20.2 KB · Affichages: 29
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier les lignes d'un tableau avec conditions dans un nouveau fichier

Bonjour Ymonte et bienvenu(e), bonjour le forum,

Peut-être comme ça, avec la macro ci-dessous à placer dans le classeur MATRICE TARIF ACHATS qui devient donc .xlsm :
Code:
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Long 'déclare la variable I (Incrément)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
Dim DEST As Range 'déclare la variable DEST (cellule DESTination)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
CH = CS.Path & "/" 'définit le chemin d'accès
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, 6).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 6 (=F) de l'onglet OS
Set PL = OS.Range("F6:F" & DL) 'définit la palge PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans la tableau temporaire TMP les éléments uniques (sans doublon) du dictionnaire D
For I = 0 To UBound(TMP) 'boucle sur tous les éléments uniques du tableau temporaire TMP
    Application.DisplayAlerts = False 'masque les messages Excel
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Workbooks.Open (CH & TMP(I) & ".xlsx") 'ouvre le classeur TMP(I) (génère une erreur si ce classeur n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        Workbooks.Add 'ouvre un classeur vierge
        ActiveWorkbook.SaveAs (CH & TMP(I) & ".xlsx") 'enregistre le fichier avec TMP(I) comme nom
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    Set CD = ActiveWorkbook 'définit le classeur destination CD
    CD.Sheets("Feuil1").Delete 'efface l'onglet "Feuil1" du classeur destination CD
    Application.DisplayAlerts = True 'affiche les messages Excel
    OS.Copy Before:=CD.Sheets(1) 'copy l'onglet Feuil1 du classeur source dans le classeur destination
    Set OD = CD.Sheets("Feuil1") 'définit l'onglet destination OD
    OD.Range("F1").AutoFilter Field:=6, Criteria1:="<>" & TMP(I) 'filtre la colonne 4 (=D) de l'onglet OS avec TMP(I) comme critère
    DL = OD.Cells(Application.Rows.Count, 6).End(xlUp).Row 'redéfinit la dernière ligne éditée DL de la colonne 6 (=F) de l'onglet OD
    Set PL = OD.Range("F6:F" & DL) 'redéfinit la palge PL
    OD.Range("F1").AutoFilter Field:=6, Criteria1:="<>" & TMP(I) 'filtre la colonne 6 (=F) de l'onglet OD avec "différnt de TMP(I)" comme critère
    Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles, non filtrées, de la plage PL)
    PLV.EntireRow.Delete 'efface les lignes entières de la plage PLV
    OD.Range("F1").AutoFilter 'supprime le filtre automatique
    CD.Close SaveChanges:=True 'ferme le classeur destination en enregistrant les changements
Next I 'prochain élément de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 

ymonte

XLDnaute Nouveau
Re : Copier les lignes d'un tableau avec conditions dans un nouveau fichier

Merci Robert,

ça fonctionne parfaitement.

juste pour ma culture et mon apprentissage du langage, que signifie :

CH = CS.Path & "/" 'définit le chemin d'accès

A quoi sert le dictionnaire :
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D

Je ne connaissais pas le fonctionnement du tableau temporaire TMP.

C'est du beau code et je te remercie encore.

A une prochaine peut etre et ca me donne envie de me plonger un peu plus dans les macros.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier les lignes d'un tableau avec conditions dans un nouveau fichier

Bonjour Ymonte, bonjour le forum,

juste pour ma culture et mon apprentissage du langage, que signifie :
CH = CS.Path & "/" 'définit le chemin d'accès
La propriété [expression.Path] renvoie le chemin d'accès pour accéder à l'expression. Donc CS.Path équivaut au chemin d'accès du classeur source CS (j'ai supposé que les autres classeurs étaient ou seraient enregistrés dans le même dossier). Pour ouvrir un fichier placé dans un dossier il faut le chemin complet (CS.Path) + un Slach (/) + plus le nom du fichier. En stockant dans la variable CH le chemin (CS.Path) + le slash (& "/"), il ne me restera que le nom du fichier à la fin (stocké dans la variable TMP(I)) pour pouvoir ouvrir avec :
Code:
Workbooks.Open (CH & TMP(I) & ".xlsx")
ou le créer avec :
Code:
Workbooks.Add
ActiveWorkbook.SaveAs (CH & TMP(I) & ".xlsx")
A quoi sert le dictionnaire :
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
Je ne connaissais pas le fonctionnement du tableau temporaire TMP.
Je te renvoie sur le site de Jacques Boisgontier car là que j'ai appris à l'utiliser... Il permet, entre autre, de récupérer les éléments d'une liste en supprimant les doublons. Ce qui a permis d'avoir la liste des fournisseurs...
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
643

Statistiques des forums

Discussions
312 215
Messages
2 086 333
Membres
103 188
dernier inscrit
evebar