Discussion :

[début_ant_VBA]

Bonjour à tous,

Nouveau sur le forum et grand débutant en VBA je me remets aux experts pour avis, conseils et aide.

Je travaille quotidiennement sur une feuille appelée sheet1 qui rassemble la totalité de mes données. En colonne A de cette feuille j'ai des dates MAY 17, JUN 17...MAR 18, APR 18, et je compte bien continuer de rajouter les dates à venir.

L'idée est de créer une macro qui sépare les données et crée une feuille par date (qui sera nommée par la date qu'elle regroupe). Dans chacune des feuilles je voudrais copier les lignes entières du tableau principal. Par exemple si en cellule A10 le mot clé est "JUL 17" je voudrais copier la ligne complète dans une feuille appelée JUL 17.

J'ai une base de travail que j'ai contruite de différents exemples trouvés en ligne et d'un peu de jujotte. Mais je reste coincé sur deux principaux points.

• Le code crée différentes feuilles en fonction des dates qui sont présentes en colonne A de la feuille sheet1 mais je souhaiterais copier sur chaque nouvelle feuille créée un entête présent sur la feuille sheet1. En me basant sur le nom de la feuille en question j'arrive à copier l'entête mais si demain je rajoute une date et donc une feuille nouvelle mon programme ne sera pas complet et certaines feuilles n'auront pas d'entête.
• Le code copie les données en fonction du mot clé (mois) dans des feuilles nouvelles mais je voudrais les copier dans les feuilles déjà créés auparavant. Par exemple si le mot clé trouvé est JAN 18 je voudrais que le code ouvre la feuille JAN 2018 déjà existante et copie la ligne entière à cet endroit là.

Je ne sais pas si je suis très clair mais n'hésitez pas à me poser plus de questions si besoin.

Voilà le code que j'ai aujourd'hui. Et je vous attache aussi le fichier à partir duquel je travaille si cela peut vous aider à comprendre ce que je raconte (désolé mais le fichier est trop volumineux. J'attache donc une photo du tableau de base. Si vous utilisez une autre méthode pour échanger vos fichiers de travail je suis preneur pour vous faciliter la compréhension
.
Merci beaucoup pour votre aide et au plaisir d'apprendre de vos compétences.
Bonne journée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub CutData()
 
Dim MotCle
Dim a As Byte
Dim i As Byte
Dim c As Range
Dim F As String
Dim Ligne As Long
Dim Nom As String
Dim d As Range
Dim n As Byte
Const lideb = 1
Const lifin = 30
Dim plage As Range
Dim li As Long
 
    'On supprime toutes données dans la feuille MonthsExtract
        Worksheets("MonthsExtract").Range("A1:A65536").ClearContents
 
    'On supprime la sheet1 (2) qui est la copie des données d'origines
        On Error Resume Next
            Application.DisplayAlerts = False
            Sheets("sheet1 (2)").Delete
            Application.DisplayAlerts = True
 
 
   'On copie la feuille de données
            a = Sheets.Count
            Sheets("sheet1").Select
            Sheets("sheet1").Copy After:=Sheets(a)
 
 
    'On copie les mois existants en supprimant les doublons dans un onglet MonthsExtract
            Range("A11:A" & Range("A65536").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("MonthsExtract").Range("A1"), Unique:=True
            With ThisWorkbook.Worksheets("MonthsExtract").Range("A1")
                If .Value = "(%)" Then .EntireRow.Delete
            End With
 
 
    'On crée nouvelle feuille pour chaque mois existant
            With ActiveSheet.Name = Sheets("MonthsExtract")
                For li = 1 To Range("A" & Rows.Count).End(xlUp).Row 'JE VOUDRAIS QUE LA BOUCLE S'ARRETE QUAND LE CODE RENCONTRE UNE CELLULE EN A VIDE
                Sheets.Add
                ActiveSheet.Name = Sheets("MonthsExtract").Range("A" & li)
                plage.Copy .Range("A" & li)
                Next li
            End With
            Application.DisplayAlerts = False 'deactive les messages autorisation d'effacer
 
            For Each Sh In Sheets
    'On supprime les feuilles qui commencent par Feuil
            If Left(Sh.Name, 5) = "Feuil" Then Sh.Delete
            Next
            Application.DisplayAlerts = True 'reactive les messages autorisation d'effacer
 
    'On copie les entetes
  '         For Each Sh In Worksheets
                Sheets("sheet1").Range("A7:Z11").Copy
                Sheets("APR 2018").Range("A1").PasteSpecial Paste:=xlPasteFormulas 'JE VOUDRAIS COPIER SUR CHAQUE FEUILLE CREEE PEU IMPORTE SON NOM (EN GROS CHAQUE FEUILLE QUI CORRESPOND A UN MOIS), JE NE SAIS PAS SI ON PEUT UTILISER LA LISTE MONTHSEXTRACT ?
                Sheets("APR 2018").Range("A1").PasteSpecial Paste:=xlPasteFormats
 
 
 
    'On définit les mots clés
                MotCle = Array("MAY 17", "JUN 17", "JUL 17", "AUG 17", "SEP 17", "OCT 17", "NOV 17", "DEC 17", "JAN 18", "FEB 18", "MAR 18", "APR 18", "MAY 18", "JUN 18", "JUL 18", "AUG 18", "SEP 18", "OCT 18", "NOV 18", "DEC 18")
    'On effectue la recherche de chaque mot clé dans la colonne A de la sheet1
                For i = 0 To UBound(MotCle)
                    Do
                        Set c = Worksheets("sheet1 (2)").Columns(1).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
    'Si le mot clé est trouvé
                        If Not c Is Nothing Then
    'On définit le nom de la feuille où sera effectuée la copie
                        F = "sheet" & (i + 2) 'JE VOUDRAIS COPIER LES DONNEES DANS LES ONGLETS PRECEDEMMENT CREES EN FONCTION DU MOT CLE MAIS JE NE SAIS PAS COMMENT LES APPELER ICI
                            With Worksheets(F)
    'On définit la ligne où sera effectué le collage
                            Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
    'On effectue le copier / coller
                            c.EntireRow.Copy .Range("A" & Ligne)
    'On supprime la ligne dans la sheet1
                            c.EntireRow.Delete
                            End With
                        End If
                        Loop While Not c Is Nothing
                    Next i
 
End Sub