De l'aide pour une macro boucle

[titi7500]

Bonjour j'ai un petit soucis, ne sachant pas utiliser la fonction vba d'excel, je n'arrive pas à créer une macro répondant à mon problèmes.

Je vous explique rapidement.

J'ai un fichier excel avec dedans un onglet qui me sert d'extraction et j'ai plusieurs onglet . Chaque onglet porte le code que l'on peut trouver dans la colonne B de l'onglet extraction.

Ce que je souhaite c'est que les donnés de l'extraction se copie colle de la ligne A à la ligne D dans l'onglet en fonction de la colonne B et que la macro boucle se stop quand je n'ai plus rien dans la colonne B.

Il y a une extraction mensuelle on peut atteindre facilement les 10k lignes dans l'extraction

Ci joint un extrait de mon fichier excel.

Une petite aide de votre part serait très apprécié.

Merci par avance.

 

[titi7500]

par contre j'arrive pas a faire en sorte que le copier coller se soit fait sur la ligne 9 des onglets ....

 

[Calvus]

Re,

Voici le code pour copier jusqu'à la colonne Z

Sub Dispatch2()
Dim WS As Worksheet, i As Integer, j As Integer, k As Integer
For Each WS In Sheets
    For i = 2 To Range("B" & Rows.Count).End(3).Row
        If Cells(i, 2) = WS.Name Then
            For j = 2 To Range("B" & Rows.Count).End(3).Row
                If Cells(j, 2) = WS.Name Then
                    WS.Range("A" & Rows.Count).End(3).Rows(2) = Cells(i, 1)
                        For k = 1 To 26
                            WS.Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(i, k + 1)
                        Next
                End If
            Next
        End If
    Next i
Next
End Sub

 

[Calvus]

Et pour éviter les doublons

Sub Dispatch3()
Dim WS As Worksheet, i As Integer, j As Integer, k As Integer
For i = 1 To Sheets.Count
        If Cells(i, 2) Like Sheets(i).Name Then
            For j = i To Range("B" & Rows.Count).End(3).Row
                If Cells(j, 2) Like Sheets(i).Name Then
                    Sheets(i).Range("A" & Rows.Count).End(3).Rows(2) = Cells(j, 1)
                        For k = 1 To 26
                            Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1)
                        Next
               End If
            Next
        End If
Next
End Sub

 

[titi7500]

tu es top calvus par contre j'ai toujours pas reglé mon soucis de prendre les lignes a copier et de copier dans les onglets qu'a partir de la ligne 9

 

[Calvus]

Bonjour,

Il suffit de remplacer par For j = 9

A+

 

[titi7500]

Le for j dans la macro c'est for j = i et le for i = 1.

Quand je remple par for j = 9 ca coller toujours sur la ligne 2 .
Et quand je remplace le for i = 9 rien se passe ...

 

[Calvus]

Bonjour non ?...

Quand je remple par for j = 9 ca coller toujours sur la ligne 2 .

Tu veux coller sur les mêmes lignes ???
Explique toi car je ne comprends pas la démarche.

Et quand je remplace le for i = 9 rien se passe ...

C'est normal, puisqu'il n'y a que 8 feuilles de code.
La feuille 9 n'existe pas.

 

[titi7500]

excuse moi comme je suis resté sur la continuité de la conversation d'hier j'ai oublié de te dire bonjour ...

En faite je voudrais que dans chaques onglets (hors l'onglet extraction) les copier coller se fassent à partir de la ligne 9 et non la 2.

 

[Calvus]

Re,

Ah ok.

Alors comme ça peut être

Sub Dispatch3()
Dim i As Integer, j As Integer, k As Integer
For i = 1 To Sheets.Count
        If Cells(i, 2) Like Sheets(i).Name Then
            For j = i To Range("B" & Rows.Count).End(3).Row
                If Cells(j, 2) Like Sheets(i).Name Then
                    If Sheets(i).Range("A9") = "" Then
                        Sheets(i).Range("A9") = Cells(j, 1)
                            For k = 1 To 26
                                Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1)
                            Next
                    Else
                        Sheets(i).Range("A" & Rows.Count).End(3).Rows(2) = Cells(j, 1)
                            For k = 1 To 26
                                Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1)
                            Next
                    End If
               End If
            Next
        End If
Next
End Sub

A+

 

[titi7500]

Ah parfait tu déchires par contre j'aimerais un truc en plus dessus stp, en gros quand je clique sur le bouton pour que la macro se met en route j'aimerais qu'il me demande si je veux lancer le dispatch et je veux répondre par O ou N ou Oui ou Non et qu'a la fin quand il a finit il ouvre encore une page de dialogue pour me dire dispatch terminé.

est-ce possible ?

Merci

 

[Calvus]

Re,

2 lignes à ajouter :

Sub Dispatch3()
Dim i As Integer, j As Integer, k As Integer
If MsgBox("Voulez vous lancer la macro ?", vbYesNo) = vbNo Then Exit Sub
For i = 1 To Sheets.Count
        If Cells(i, 2) Like Sheets(i).Name Then
            For j = i To Range("B" & Rows.Count).End(3).Row
                If Cells(j, 2) Like Sheets(i).Name Then
                    If Sheets(i).Range("A9") = "" Then
                        Sheets(i).Range("A9") = Cells(j, 1)
                            For k = 1 To 26
                                Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1)
                            Next
                    Else
                        Sheets(i).Range("A" & Rows.Count).End(3).Rows(2) = Cells(j, 1)
                            For k = 1 To 26
                                Sheets(i).Range("A" & Rows.Count).End(3).Rows(1).Offset(, k) = Cells(j, k + 1)
                            Next
                    End If
               End If
            Next
        End If
Next
MsgBox "Opération terminée"
End Sub

A+

 

[titi7500]

Ah merci beaucoup, en faite c'est facile et pas facile en même temps ... Par contre j'ai remarqué un truc quand on lance la macro oui la macro s'arrête quand ya plus rien par contre quand on relance la macro elle rajouté les memes lignes. Du coup voici une nouvelle problématique, l'extraction est alimentée tous les mois donc chaque mois quand je vais utiliser la macro j'aurais des doublons ma question est : peux t'on créer une nouvelle macro qui supprimera toutes les données de tous les onglets à partir de la ligne 9 jusqu'à la ligne 10000. Comme ça tout les mois je peux utiliser la première macro sans avoir de doublons

 

[Calvus]

Re,

On doit pouvoir faire mieux, mais en attendant voici ce qui devrait répondre à ta problématique.
En début de code, remplace les premières lignes par celles-ci :

Sub Dispatch3()
Dim i As Integer, j As Integer, k As Integer
If MsgBox("Voulez vous lancer la macro ?", vbYesNo) = vbNo Then Exit Sub
For i = 2 To Sheets.Count
Sheets(i).[A9].CurrentRegion.Clear

A+

 

[titi7500]

D'accord je vais tâcher de changer le début par contre pour éviter de me tromper le 2e if qu'on voit dans le code je le laisse? En gros je dois avoir la partie à changer et la ligne d'en dessous le if ?

Et tu peux me traduire littéralement ce que veut dire le debut ( après la modification)?

Merci

 

[Calvus]

Re,

Voici, suite à l'autre discussion que tu as lancée, demandant de l'aide pour réaliser une macro, le classeur avec les modifications et le code commenté.

J'espère que cela te permettra d'avancer. Mais lis tout de même ce que je t'ai écrit de l'autre coté.

A+