Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

copier données tableau dans nouveau classeur en fonction critères

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion zbee
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Z

zbee

Guest
Bonsoir à tous,

Voilà ce que je souhaiterais faire en code VBA

Dans le tableau joint, j'ai fait un tri en fonction du contenu de la colonne D (Service)
Je voudrais pouvoir copier toutes les lignes contenant CC1 et les coller dans un nouveau classeur
et refaire la même manipulation pour toutes les lignes contenant CC2 dans un autre classeur

Une boucle qui ferait quelquechose comme:
Si dans la colonne D je trouve CC1
je copie cette ligne dans un nouveau classeur
je passe à l'autre ligne
Si dans la colonne D je trouve CC2
je copie cette ligne dans un autre nouveau classeur

Quelqu'un a une idée?
 

Pièces jointes

Trier par date Trier par votes
Re : copier données tableau dans nouveau classeur en fonction critères

Bonjour
Voici une solution en retour
pour lancer les macros : alt+F8 proctstandard
Cordialement
Flyonets
 

Pièces jointes

Vote positif 0 Vote négatif
Re : copier données tableau dans nouveau classeur en fonction critères

Bonjour zbee, flyonets44,

Voici une autre solution qui utilise aussi le Filtre automatique.

Il n'est pas nécessaire que la colonne D soit triée :

Code: 
Sub CréationFichiers()
Dim derlig&, d As Object, cel As Range, a, plage As Range
derlig = [D65536].End(xlUp).Row
If derlig = 1 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà créé
'---liste des Services sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For Each cel In [D2].Resize(derlig - 1)
  If cel <> "" Then d(cel.Value) = cel.Value
Next
'---création des fichiers---
For Each a In d.keys
  ActiveSheet.Copy
  ActiveSheet.Name = a
  Set plage = ActiveSheet.[D1].Resize(derlig)
  plage.AutoFilter 1, "<>" & a
  Set plage = plage.Offset(1).SpecialCells(xlCellTypeVisible)
  ActiveSheet.AutoFilterMode = False
  plage.EntireRow.Delete
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & a
  ActiveWorkbook.Close
Next
End Sub
Fichier joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : copier données tableau dans nouveau classeur en fonction critères

Re,

Evidemment si l'on ne veut créer les fichiers que pour certains services c'est plus simple.

Il suffit de les lister dans le tableau tablo :

Code: 
Sub CréationFichiers()
Dim derlig&, tablo, a, plage As Range
derlig = [D65536].End(xlUp).Row
If derlig = 1 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà créé
'---liste des Services ---
tablo = Array("CC1", "CC2")
'---création des fichiers---
For Each a In tablo
  ActiveSheet.Copy
  ActiveSheet.Name = a
  Set plage = ActiveSheet.[D1].Resize(derlig)
  plage.AutoFilter 1, "<>" & a
  Set plage = plage.Offset(1).SpecialCells(xlCellTypeVisible)
  ActiveSheet.AutoFilterMode = False
  plage.EntireRow.Delete
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & a
  ActiveWorkbook.Close
Next
End Sub
Fichier (2).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : copier données tableau dans nouveau classeur en fonction critères

Re,

Juste un détail évident.

Les noms des Services ne doivent pas contenir de caractères interdits pour les noms de fichiers ou les noms de feuilles...

Edit : catactères interdits :

- nom de fichier / \ : * ? " < > |

- nom de feuille / \ : * ? [ ] ' plus de 31 caractères

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : copier données tableau dans nouveau classeur en fonction critères

Re, pour terminer,

On aura remarqué que la macro supprime une ligne vide, avant le texte Touches Ctrl+A...

Si cela est gênant, utiliser les macros des fichiers bis joints, où l'on notera :

Set plage = plage.Offset(1).Resize(derlig - 1).SpecialCells(xlCellTypeVisible)

Edit : j'ai simplifié la macro du fichier (1bis) par rapport au (2bis) au niveau du filtrage

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : copier données tableau dans nouveau classeur en fonction critères

Merci beaucoup Job75,

comme je débute en VBA,
j'ai peu de mal à décripter toutes les instructions
peux-tu me traduire en français les différentes instructions
histoire que je sois autonome la prochaine fois et surtout que je puisse adapter le code dans d'autres situations

Et aussi les 2 fichiers créés ne restent pas afficher
comment faire pour qu'ils restent affichés?
merci

Sub CréationFichiers()
Dim derlig&, d As Object, cel As Range, a, plage As Range
derlig = [D65536].End(xlUp).Row
If derlig = 1 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà créé
'---liste des Services sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For Each cel In [D2].Resize(derlig - 1)
If cel <> "" Then d(cel.Value) = cel.Value
Next
'---création des fichiers---
For Each a In d.keys
ActiveSheet.Copy
ActiveSheet.Name = a
If d.Count > 1 Then
Set plage = ActiveSheet.[D1].Resize(derlig)
plage.AutoFilter 1, "<>" & a
Set plage = plage.Offset(1).Resize(derlig - 1).SpecialCells(xlCellTypeVisible)
ActiveSheet.AutoFilterMode = False
plage.EntireRow.Delete
End If
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & a
ActiveWorkbook.Close
Next
End Sub
 
Vote positif 0 Vote négatif
Re : copier données tableau dans nouveau classeur en fonction critères

Bonjour zbee, le forum,

En général il est préférable de fermer les fichiers créés mais enfin...

Voir le fichier joint avec plein de commentaires explicatifs.

J'ai mis un contrôle d'erreur On Error Resume Next pour le cas où l'on lance la macro avec les fichiers CC1 et/ou CC2 ouverts.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

R
  • Question Question
XL 2021 Recherche formule pour compléter une cellule a partir des données d'une autre feuille du classeur (16/03/2026)
2
Réponses
18
Affichages
592
laurent950
G
  • Question Question
XL 2016 filtrer, copier et coller les données avec la macro
Réponses
4
Affichages
323
job75
C
  • Résolu(e)
XL 2019 User Form qui renvoi dans un tableau avec celulle fusionnée
2
Réponses
16
Affichages
363
Piment
P
  • Résolu(e)
XL 2021 VBA - Comment transformer un classeur enregistré en classeur non enregistré
2 3
Réponses
34
Affichages
1 K
patricktoulon
A
  • Question Question
Déplacer données en vba
Réponses
3
Affichages
560
akm
A
F
  • Question Question
XL 2016 recherche données et collage
Réponses
4
Affichages
230
finarobert
F
N
  • Question Question
XL 2021 Affecter automatiquement une valeur dans une cellule en fonction d'une saisie dans une autre cellule
Réponses
9
Affichages
322
Nico Gre
N
  • Question Question
Microsoft 365 Effacer (et non supprimer) une ligne suivant texte.
Réponses
6
Affichages
429
DAVID-44-
C
  • Question Question
Microsoft 365 Actualisation de TCD
Réponses
12
Affichages
364
Dan
M
  • Résolu(e)
XL 2021 Récupérer la valeur d’une cellule dans un classeur fermé
Réponses
5
Affichages
352
patricktoulon
H
  • Question Question
XL 2019 Masquer des lignes sous condition en vba
Réponses
8
Affichages
297
job75
M
  • Résolu(e)
Microsoft 365 $ Macro pour copier un exemple et$.....
Réponses
9
Affichages
517
sousou
J
  • Résolu(e)
XL 2021 Classement données avec recherchex en cas de données de même valeur
Réponses
6
Affichages
268
jeff2318
J
C
  • Résolu(e)
Microsoft 365 Recherche de doublons à plusieurs critères sur plusieurs colonnes
Réponses
4
Affichages
369
job75
J
  • Question Question
Microsoft 365 Naviguer dans un tableau pour copier des données dans un modèle et copier l'un derrière l'autre
Réponses
11
Affichages
545
AtTheOne
C
  • Question Question
Microsoft 365 Fonction si
Réponses
7
Affichages
223
Cathel
C
T
  • Résolu(e)
XL 2010 Mise en surbrillance dans tableau selon 2 critères
Réponses
11
Affichages
338
AtTheOne
M
  • Résolu(e)
Microsoft 365 Trouver une valeur dans une colonne
Réponses
7
Affichages
565
mikeduff
M
  • Question Question
XL 2019 Gestion de 4 sources de revenu (A, B, C et D). Et rajout du jour en cours et MEFC qui doit varier selon le mois en cours...
Réponses
8
Affichages
268
sylvanu
  • Résolu(e)
XL 2021 tableau de données
Réponses
9
Affichages
491
AtTheOne
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…