Discussion :

[arthur203]

Bonjour à tous !
Un challenge de taille pour vous expert de vba !

Je souhaite à partir d'un tableau1 de données extraire les informations contenus dans chaque ligne et les coller dans un autre tableau2 (au format différent) qui sera créer dans différents onglets ( 1 onglet = 1 ligne). Ces onglets seront créer dans différents fichiers excel en fonction du secteur d'activité. En gros:
1 secteur d'activité = x ligne du tableau => création d'un nouveau fichier Excel au nom du secteur d'activité qui contiendra x onglets dans chaque onglet un tableau2 où on retrouvera les mêmes informations que le tableau1 mais organisées différemment.

C'est dur à expliquer donc ci-joint le fichier Excel où j'ai essayé d'illustré précisément ce que je souhaite obtenir.

Merci de m'éclairer autant que faire se peut

[SfJ5Rpw8]

Bonjour,

et c'est quoi ton problème ? qu'as tu déjà codé ? ou bloque tu ..?
as tu fais un tour vers les divers tutoriels du site pour t'aider à débuter ?


Fichier joint dans vos discussions

[arthur203]

Bonjour bbil,

Au départ, j'ai pensé à compter le nombre de ligne par bloque de cellule fusionnée en utilisant Application.ThisWorkbook.Worksheets("feuil1").Range("C1").MergeArea.rows.Count et ensuite faire une boucle Do while tant que le nombre de ligne et inférieur au nombre de ligne fusionné tu ajoute des onglets ça donnait:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test1()
    Dim ligne As Integer
    ligne = 1
    Range("D1").Value = Application.ThisWorkbook.Worksheets("feuil1").Range("C1").MergeArea.rows.Count
 
  Do While ligne < Range("D1").Value
  Worksheets("feuil").Activate
        Sheets.Add
        ActiveSheets.Name = Cells(ligne, 1).Value
        ligne = ligne + 1
    Loop
 
End Sub

Mais la je bloquais je n'arrivais pas à créer un nouveau classeur par bloc de cellules fusionnées il fallait que je spécifie à chaque fois l'emplacement des cellules fusionnées.

Ensuite j'ai fractionné toutes les cellules fusionnées et recopié le nom du secteur et j'ai fais une boucle tant que le nom du secteur et le meme tu crée un nouveau classeur et autant d'onglets qui corresponde au secteur. De plus, il faut précisé à chaque fois le nom des secteurs:

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
Sub ajout()
Dim x As Variant
Dim y, w, z As Variant
Dim ligne
x = Range("C1").Value 'x = nom du secteur1
y = Range("C3").Value 'y = nom du secteur2
ligne = 1
If Cells(ligne, 3) = x Then
        Workbooks.Add     
        Do While Cells(ligne, 3) = x 'la cellule en colonne 3 contient le nom du secteur 1 
            w = Cells(ligne, 1).Value 
            Sheets.Add 'alors tu crée un onglet
            ActiveSheet.Name = w 'tu nomme l'onglet par le contenu de la colonne 1 
           ligne = ligne + 1        
        Loop
End If      
If Cells(ligne, 3) = y Then
        Workbooks.Add       
        Do While Cells(ligne, 3) = y 
            z = Cells(ligne, 1).Value
            Sheets.Add
            ActiveSheet.Name = z
            ligne = ligne + 1
        Loop
End If       
End Sub

C'est barbare mais ça marche, ensuite il me faut reprendre le modèle et le copié dans chaque onglet et affecter les informations au cellule adéquate et la je sèche.

Par contre j'ai trouvé dans un forum une macro qui fais exactement ce que je souhaite faire mais je n'arrive pas à l'adapter à mon modèle la macro est:

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
Private Sub CommandButton1_Click()
Dim Tab_Données As Variant
Dim Compteur As Integer, Compteur2 As Integer
Dim Classeur_récap As Workbook
 
Tab_Données = Range("A2: D" & Range("A65536").End(xlUp).Row)
For Compteur = LBound(Tab_Données) To UBound(Tab_Données)
    If Compteur = 1 Then
        ThisWorkbook.Sheets("Modele").Copy
        Set Classeur_récap = ActiveWorkbook
    Else
        ThisWorkbook.Sheets("Modele").Copy After:=Classeur_récap.Sheets(Classeur_récap.Sheets.Count)
    End If
    ActiveSheet.Name = Tab_Données(Compteur, 1)
    For Compteur2 = 1 To 4
        ActiveSheet.Range("B1").Offset(Compteur2 - 1, 0).Value = Tab_Données(Compteur, Compteur2)
    Next Compteur2
 
Next Compteur
End Sub

le problème c'est qu'ici les données sont collées les unes après les après les autres et je n'arrive pas à insérer ma condition qui dit que si le secteur change créer un nouveau classeur.
Merci de votre aide !