Discussion :

[kaudriss]

Bonjour,
Je débute macro excel et j'aurai besoin de votre aide pour une macro:
Mon fichier excel comprend 33 sheets (1 sheet appelé Data et 32 sheets intitulés M0001, M0002,...M0032)
Le Sheet "Data" comprend tout un tas de données sachant que dans la première colonne se trouve des numéros de machine
M0001, M0002,... mais pas uniformément (il y a peut être 3*M0001, 15*M0002, 1*M0003...)
Ce que j'aimerais faire, c'est coller le contenu des lignes des machines dans les sheets correspondants
à partir de la colonne 15. Ainsi, toutes les lignes du sheet Data qui commencent par M0001 sont copiés dans le sheet
M0001 à partir de la ligne 15 (mais sans la colonne M0001 du sheet Data), idem pour les 31 autres.
J'espère avoir été assez clair, sinon n'hésitez pas à me demander des infos supplémentaires.

Je ne sais pas trop par où commencer ni la difficulté de cette macro mais si vous pouviez me donner un petit coup
de main, ça m'aiderait vraiment beaucoup.

Merci

Voici le fichier excel avec les données et tous les onglets.
Ca sera plus simple à comprendre mais j'ai du supprimer quelques onglets pour atteindre la taille du fichier max autorisé
Merci beaucoup

[MarcelG]

Bonjour kaudriss,

Sois la bienvenue au club.

Dans ton fichier, il faut une homogénéité entre le nom des feuilles et les occurences de la colonne A de ta feuille Data.

Ici, j'ai pris un exemple pour M0001 en adaptant un code que j'ai proposé dans une discussion récente. (Je préfère lesTableaux aux filtres)
Adapte la boucle en k

Il faut que la feuille M0001 existe.

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
Public Sub Balayage()
 
Dim k As Integer
'Balayage des occurences 1 à 1, à adapter
For k = 1 To 1
    cherchervaleur k
Next k
 
End Sub
 
Sub cherchervaleur(n As Integer)
Dim tbl()
Dim plage As Range
Dim cel As Range
Dim adr As String
Dim j As Integer, m As Integer
Dim lavaleur As String
 
 
Application.ScreenUpdating = False
 
        With Sheets("Data")
 
                'Définition du critère
                lavaleur = "M" & Format(n, "000#")
                Debug.Print lavaleur
                .Activate
                'Recherche de la dernière ligne
                dercel = .Cells(.Rows.Count, 1).End(xlUp).Row
                'Définition de la zone de recherche
                Set plage = .Range("A2:A" & dercel)
                '1ère occurence trouvée
                Set cel = plage.Find(lavaleur, LookIn:=xlValues)
                'Si la 1ère occurence n'est pas vide, on cherche toutes les suivantes
                If Not cel Is Nothing Then
 
                        'Mise en mémoire de l'adresse de la 1ère occurence
                        adr = cel.Address
 
                        Do
 
                                m = m + 1
                                'Augmentation de la 2ème dimension du Tableau (nombre de lignes)
                                ReDim Preserve tbl(1 To 23, 1 To m)
                                'Enrichissement des valeurs contenues sur la même ligne
                                'dans les colonnes j à gauche de l'occurence trouvée
                                For j = 1 To 23
                                        tbl(j, m) = cel.Offset(0, j)
 
                                Next j
                                'Recherche de la prochaine occurence
                                Set cel = plage.FindNext(cel)
 
                        'La recherche continue tant que l'occurence trouvée n'est pas la 1ère
                        Loop While adr <> cel.Address
 
                End If
 
                End With
 
                Debug.Print UBound(tbl, 2)
                Debug.Print UBound(tbl, 1)
                With Sheets(lavaleur)
                .Select
                'La feuille est enrichie des données du tableau
                .Range(Cells(1, 1), Cells(UBound(tbl, 2), UBound(tbl, 1))).Offset(14, 0) = Application.WorksheetFunction.Transpose(tbl())
        End With
 
'Variables réinitialisées
Set plage = Nothing
Set cel = Nothing
Erase tbl
 
End Sub

A adapter donc.

Et reviens si nécessaire.