Copier cellules sous conditions vers un nouveau classeur!!

[idimpact]

Bonjour à tous!!

Bon débutant sous VBA, j'essaye de trouver des morceaux de codes sur internet en fonction des problématiques que je rencontre et comprendre le fonctionnement du codage.

ici mon souhait est de creer une macro qui a partir du classeur TESTMACRO, crée un nouveau fichier Excel avec 6 onglets (voir ci dessous). Je souhaite que la macro me fasse un tri sur la feuille du classeur Test Macro pour avoir dans le nouveau fichier crée les int futur regroupé sous l'onglet int futur etc... Je dois faire cette extraction tous les jours. donc deux conditions pour exporter les cellule vers les onglets, la date du jour et le nom de code.

j'ai fait ce bout de code pour creer un nouveau classeur avec mes onglets, mais au niveau de la copie ca coince...

HELP ME!! Merciiiii

Sub AddNewWorkbook()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet


Sheets("LISTE").Select
Range("A1:O63").Copy

'On créer l'objet Excel
Set xlApp = CreateObject("Excel.Application")
'On défini le nombre d'onglets (ici 6)
xlApp.SheetsInNewWorkbook = 6
'On ajoute un classeur
Set xlBook = xlApp.Workbooks.Add
'On rend le classeur visible
xlApp.Visible = True
'On créer l'objet onglet dans le nouveau classeur créé
Set xlSheet = xlBook.Worksheets(1)
'On affecte un nom aux l'onglets
xlSheet.Name = "Général"
'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
Set xlSheet = Nothing
'
'
Set xlSheet = xlBook.Worksheets(2)
xlSheet.Name = "Rendez-vous"
Set xlSheet = Nothing

Set xlSheet = xlBook.Worksheets(3)
xlSheet.Name = "Int Futur"
Set xlSheet = Nothing

Set xlSheet = xlBook.Worksheets(4)
xlSheet.Name = "Demande d'infos"
Set xlSheet = Nothing

Set xlSheet = xlBook.Worksheets(5)
xlSheet.Name = "Refus"
Set xlSheet = Nothing

Set xlSheet = xlBook.Worksheets(6)
xlSheet.Name = "Suivi"
Set xlSheet = Nothing

'On donne un nom à chaque onglets
With Worksheets("Général").Range("a1")
.PasteSpecial Paste:=xlPasteValidation
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlPasteColumnWidths
'
End With


'On remet la propriété de l'application à 3 (par défaut)
xlApp.SheetsInNewWorkbook = 3

 

[Bebere]

Re : Copier cellules sous conditions vers un nouveau classeur!!

Bonjour
fichier avec code et résultat obtenu
à bientôt

 

[idimpact]

Re : Copier cellules sous conditions vers un nouveau classeur!!

merci Bebere!

J'ai essayé de décortiquer ta macro et il faut dire ce qui est, je rame un peu (bcp)

Si X est le nombre de feuilles qui vont etre crées, il s'agit d'une variable qui ne peut exéder 6.

Onglet Général pour une date donnée(avec ensemble des données des 5 feuilles qui suivent)

RDV
Int futur
Demande Infos
Refus
Suivi

En gros je demande a excel de faire une sélection des données à exporter en fonction d'une date. Toutes les lignes du tableau correspondant a cette date se trouveront dans mon onglet General du nouveau classeur crée.

Ensuite je souhaite qu'Excel prenne pour la date sélectionnée les lignes ou figure dans la colonne F "RDV" et cree une feuille RDV. Ensuite il prend dans la colonne F les 'Int futur' de la date selectionee et les copie dans une feuille int futur... ainsi de suite

Je souhaite que dans mes onglets figure le tableau (pas seulment les colonnes Code et date).


J'ai supprimé la fin du code pour que l'utilisateur enregistre le fichier en choisissant la destination. Cela permet aussi a l'utilisateur de vérifier si le fichier comporte les bonnes infos.

merci pour ton aide, je suis sur le fichier depuis 2 heures avec l'aide visual basic, J'ai essayé de faire des changements notamment pour avoir tout le tableau dans les nouvelles feuilles crées mais sans succès.

Si tu pouvais me fournir des infos par rapport a ce que j'ai expliqué au dessus! Merci bcp parce aue la je bloque


Sub AddNewWorkbook()
Dim iSheets As Integer, Cel As Range
Dim X As Object, i As Integer, L As Long, Li As Long
Dim Chemin As String, Nom As String, Myfile As String

iSheets = Application.SheetsInNewWorkbook

Set X = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Worksheets("LISTE") 'le nom de ma feuille dans mon classeur excel
For Each Cel In .Range("F2:F" & .Range("F10000").End(xlUp).Row)
If Not X.Exists(Cel.Value) Then
X.Add (Cel.Value), CStr(Cel.Value) 'CStr correspond au format de la date
End If
tbl = .Range("F2:Z" & .Range("F65536").End(xlUp).Row) 'creation du tableau dans le nouveau classeur
Next
End With

Application.SheetsInNewWorkbook = X.Count 'definit les nombre de feuilles dans le nouveau classeur
Workbooks.Add
Application.SheetsInNewWorkbook = iSheets 'iSheets est une variable

For Each Item In X.items 'sans doublons
j = j + 1
For L = 1 To UBound(tbl) 'UBound est utilisé pour déterminer la taille du tableau avec LBOUND
If tbl(L, 1) = Item Then
With ActiveWorkbook
.Worksheets(j).Name = Item ' Nomme la feuille avec le nom de la cellule se trouvant dans la colonne F
Li = .Worksheets(j).Range("A65536").End(xlUp).Row + 1
.Worksheets(j).Cells(Li, 1) = tbl(L, 1)
.Worksheets(j).Cells(Li, 2) = tbl(L, 3)
End With
End If
Next
Next

Chemin = ThisWorkbook.Path & "\"
Nom = "Personnes jointes le " & Format(Date, "ddmmmmyyyy") & ".xls"
Myfile = Dir(Chemin & Nom)

If Myfile = "" Then ActiveWorkbook.SaveAs Chemin & Nom



End Sub

 

[Bebere]

Re : Copier cellules sous conditions vers un nouveau classeur!!

Bonjour idimpact
ajout d'1 userform por choisir une date,et changer le code
à bientôt

 

[idimpact]

Re : Copier cellules sous conditions vers un nouveau classeur!!

merci! Tu qs bien compris mon probleme et ta macro semble bien fonctionné, je n'ai pas le temps de la décortiquer aujourd'hui mais je l'adapeterai surement à mon fichier demain. Merci encore et tes commentaires sur la macro vont m'aider à mieux la comprendre

 

[idimpact]

Re : Copier cellules sous conditions vers un nouveau classeur!!

Salut!

J'ai bien avancé grace a ton exemple de Macro et la mienne est presque opérationnelle.

Je souhaiterai encore te poser deux question :

Lors de la creation des onglets dans le nouveau classeur la formule est

For Each Item In X.items

Moi je souhaiterai prendre seulement les items qui corresponde aux valeurs RDV, Oui, Non etc...


J'ai remarqué qu'il fallait placer le commandbutton pour appel du Userform sur la feuille ou se situe les infos sinon excel renvoie un code erreur. Une manière de contourner ce probleme.

Merci pour ton aide, j'ai jamais été aussi proche de la fin!