VBA-Dupliquer données de colonne d'un onglet dans d'autres onglets

Le 12/10/2022 à 16:12

Bonjour à tous,

Je souhaiterai avoir une macro qui permette de dupliquer des données de certaines colonnes dans des onglets existants suivant un critère présent dans l'une des colonnes de l'onglet de données principales.

Je vous mets en PJ un tableau d'exemple. La colonne de critère est la colonne K - "dépôt", les onglets ont le même que le critère de dépôt. Les colonnes à remplir ont les mêmes noms d'en-tête dans le tableau principal. Entre deux il peux y avoir des colonnes qu'il faut laisser vide (donc qu'on ne retrouve pas dans le tableau de données principales).

J'ai cherché pas mal de temps, je suis souvent tombé sur des macros qui créent des onglets, mais j'ai besoin pour ma part de remplir des tableaux dans des onglets déjà existants.

Merci d'avance pour votre aide, à dispo pour plus de détails bien évidemment,

Gaspar

18fichier-exemple-pour-forum-excel.xlsx (13.00 Ko)
Le 12/10/2022 à 16:21

Bonjour

Faut-il nettoyer les feuilles depot au préalable ?

Cordialement

Le 12/10/2022 à 16:26

Non, justement, c'est l'inverse que je souhaite.

Je colle un tableau multi-dépôt dans l'onglet "inventaire" et au lancement de la macro, les informations (choisies en fonction des en-têtes de colonnes renseignées) concernant chaque dépôt se colle dans les différents onglets "Dépôts".

Le 12/10/2022 à 16:27

Non, justement, c'est l'inverse que je souhaite

Oui désolé j'ai édité mon post précédent pendant que vous postiez le vôtre
Faut-il nettoyer les feuilles depot au préalable ?

Le 12/10/2022 à 16:36

Oui en effet.

Le 12/10/2022 à 17:01

Voici le code à placer dans l'éditeur VBA dans un module
Ensuite vous pouvez mettre un bouton sur votre feuille Livre et l'associer à ce code

Option Explicit
Option Compare Text
Sub Exporter()
Dim tablo()
Dim dlg As Integer, i As Integer, J As Integer, k As Integer
Dim feuille As String
Dim existe As Boolean

Application.ScreenUpdating = False
dlg = Range("A" & Rows.Count).End(xlUp).Row

ReDim tablo(dlg - 2, 10)
J = 0
For i = 0 To dlg - 2
    For J = 0 To 10
        tablo(i, J) = Cells(i + 2, J + 1)
    Next J
Next i

For i = 0 To UBound(tablo)
    feuille = tablo(i, 10)
    'controle si la feuille existe
    For k = 1 To Sheets.Count
        If Sheets(k).Name = feuille Then existe = 1: Exit For
    Next k
    If existe = 0 Then
        'création feuille depot si inexistante
        Worksheets.Add after:=Sheets(Sheets.Count) 
        ActiveSheet.Name = feuille
        With Sheets(feuille)
            .Cells(1, 1) = Sheets("Livre Inventaire").Cells(1, 1).Value
            .Cells(1, 2) = Sheets("Livre Inventaire").Cells(1, 2).Value
            .Cells(1, 3) = "Designation 2"
            .Cells(1, 4) = "Comptage"
            .Cells(1, 5) = Sheets("Livre Inventaire").Cells(1, 7).Value
            .Cells(1, 6) = Sheets("Livre Inventaire").Cells(1, 8).Value
        End With
    End If
    'Ajout des donnees
    With Sheets(feuille)
        dlg = .Range("A" & .Rows.Count).End(xlUp).Row
        J = 1
        .Cells(dlg + 1, J) = tablo(i, J - 1)
        .Cells(dlg + 1, J + 1) = tablo(i, J)
        .Cells(dlg + 1, J + 4) = tablo(i, J + 5)
        .Cells(dlg + 1, J + 5) = tablo(i, J + 6)
    End With
    existe = 0
Next i
End Sub

Le code créera la feuille Dépot si elle n'existe pas dans le fichier

N'oubliez pas d'enregistrer votre fichier au format XLSM

si ok -->

Cordialement

Le 12/10/2022 à 17:27

Merci beaucoup Dan pour la réactivité et le résultat.

J'ai testé sur mon fichier exemple, ça fonctionne, hormis (ou peut-être que je n'ai pas compris la question "Faut-il nettoyer les feuilles depot au préalable ?") qu'à chaque exécution de la macro, les produits s'ajoutent au fur et à mesure au lieu de reset les lignes dans les onglets dépôts pour ensuite remettre les bonnes données du tableau de données principal.

Je n'aurai pas le temps de tester avec un plus gros fichier prod avant vendredi, je clôturerai le sujet à ce moment-là.

Encore merci et bonne soirée.

Le 12/10/2022 à 17:39

je n'ai pas compris la question "Faut-il nettoyer les feuilles depot au préalable ?") qu'à chaque exécution de la macro, les produits s'ajoutent au fur et à mesure au lieu de reset les lignes dans les onglets dépôts pour ensuite remettre les bonnes données du tableau de données principal.

Je vous ai demandé cela parce que le code va reprendre à chaque fois toute la liste de la feuille Livre Inventaire. Donc si vous avez déjà exécuté le code et que vous recommencez sur la même liste elle sera deux fois dans chaque feuille dépôt.
Du coup, vous pourriez avoir des doublons.

Tout dépend de votre manière de fonctionner, bien entendu
Faites un test à ce sujet

Le 14/10/2022 à 09:42

Hello, c'est bon j'ai testé sur mon fichier de production, ça fonctionne parfaitement.

Merci beaucoup Dan.

Si je peux encore profiter un peu de vos talents ;) je veux bien que vous ajoutiez une commande qui vide au préalable les lignes des onglets dépôts avant de remettre de la donnée (uniquement les colonnes A / B / E / F, il y aura des formules dans les colonnes C et D, et d'autres formules également dans des colonnes plus lointaines)

Bonne journée à vous.

Le 14/10/2022 à 10:19

Bonjour

Si je peux encore profiter un peu de vos talents ;) je veux bien que vous ajoutiez une commande qui vide au préalable les lignes des onglets dépôts avant de remettre de la donnée (uniquement les colonnes A / B / E / F, il y aura des formules dans les colonnes C et D, et d'autres formules également dans des colonnes plus lointaines

Faites ceci dans le module du code :
- Ajoutez le code ci-dessous

Sub Nettoyer()
Dim dlg As Integer
Dim i As Byte

For i = 1 To Sheets.Count
    If CStr(Worksheets(i).Name) <> "Livre inventaire" Then
        With Sheets(Sheets(i).Name)
            dlg = .UsedRange.Rows.Count
            If dlg >= 2 Then
                .Range("A2:B" & dlg).ClearContents
                .Range("E2:F" & dlg).ClearContents
            End If
        End With
    End If
Next i
End Sub

2. Ajoutez cette ligne dans le code EXPORTER et ce, juste avant la ligne dlg = range("A".....

Call nettoyer

NB : je vous rappelle que vous devez vous trouver sur la feuille Livre pour exécuter le code. Si ce n'est pas le cas, il faudra adapter un peu le code Exporter

si ok -->

Cordialement

Le 14/10/2022 à 14:09

Top, encore merci et bonne continuation.

Le 14/10/2022 à 14:46

.... Me revoilà, j'ai recontré deux soucis avec le nettoyage sur la prod. Le premier étant un problème de dépassement de capacité que j'ai réussi à résoudre, le second étant qu'il n'y a pas que "Livre d'inventaire" où il ne faut pas clear les données, mais 3 autres feuilles qui sont "Export WiseUp" / "Sommaire" / "CMUP Aberrants"

J'ai tenté une modification de cette manière, sans succès :

Sub Nettoyer()
Dim dlg As Long
Dim i As Byte

For i = 1 To Sheets.Count
    If CStr(Worksheets(i).Name) <> "Livre inventaire" Or CStr(Worksheets(i).Name) <> "Sommaire" Or CStr(Worksheets(i).Name) <> "CMUP Aberrants" Or CStr(Worksheets(i).Name) <> "Export WiseUp" Then
        With Sheets(Sheets(i).Name)
            dlg = .UsedRange.Rows.Count
            If dlg >= 2 Then
                .Range("A2:B" & dlg).ClearContents
                .Range("E2:F" & dlg).ClearContents
            End If
        End With
    End If
Next i
End Sub
Le 14/10/2022 à 18:17

Le premier étant un problème de dépassement de capacité que j'ai réussi à résoudre,

Combien avez-vous de feuilles dans le fichier ?

J'ai tenté une modification de cette manière, sans succès :

"Sans succès", expliquez moi ce qui ne fonctionne pas

Déjà dans le code vous devez remplacer les instructions OR par AND

Le 18/10/2022 à 17:54

Re-bonjour.

Effectivement ça fonctionne en remplaçant Or par And. Merci.

Est-il normal que la macro dure une quinzaine de minutes ? (Avec ou sans l'opération nettoyage).

Pour info la liste a scinder fait 9000 lignes, à scinder sur 9 dépôts.

En tout il y a :

1 feuille sommaire / 1 feuille "Livre Inventaire" / 1 feuille TCD / 1 feuille tableau neutre de qui me permet de récupérer des infos manquantes du livre inventaire / 9 feuilles dépôts.

Pour information également, la macro prend 10sec si je ne crée pas au préalable les feuilles dépôts. Mais c'est gênant car les formules sont manquantes du coup.

Si vous avez une solution pour que ce soit plus rapide, je suis preneur.

Merci encore.

Le 18/10/2022 à 19:07

Bonjour

Est-il normal que la macro dure une quinzaine de minutes ? (Avec ou sans l'opération nettoyage).
Pour info la liste a scinder fait 9000 lignes, à scinder sur 9 dépôts.

Non ce n'est pas normal.

Essayez déjà ceci :
Au début, en dessous de l'instruction Application.screenupdating, rajoutez cette ligne

Application.Calculation = xlCalculationManual

A la fin du code juste au dessus du END SUB, rajoutez cette ligne

Application.Calculation = xlCalculationAutomatic

Faites un test et dites moi

Le 19/10/2022 à 09:13

On est sur du 3 minutes, c'est beaucoup mieux. Merci. Je mets ci-dessous le code complet final pour ceux que cela pourrait intéresser :

Option Explicit
Option Compare Text
Sub Exporter()
Dim tablo()
Dim dlg As Integer, i As Integer, J As Integer, k As Integer
Dim feuille As String
Dim existe As Boolean

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call Nettoyer
dlg = Range("A" & Rows.Count).End(xlUp).Row

ReDim tablo(dlg - 2, 10)
J = 0
For i = 0 To dlg - 2
    For J = 0 To 10
        tablo(i, J) = Cells(i + 2, J + 1)
    Next J
Next i

For i = 0 To UBound(tablo)
    feuille = tablo(i, 10)
    'controle si la feuille existe
    For k = 1 To Sheets.Count
        If Sheets(k).Name = feuille Then existe = 1: Exit For
    Next k
    If existe = 0 Then
        'création feuille depot si inexistante
        Worksheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = feuille
        With Sheets(feuille)
            .Cells(1, 1) = Sheets("Livre Inventaire").Cells(1, 1).Value
            .Cells(1, 2) = Sheets("Livre Inventaire").Cells(1, 2).Value
            .Cells(1, 3) = "Designation 2"
            .Cells(1, 4) = "Comptage"
            .Cells(1, 5) = Sheets("Livre Inventaire").Cells(1, 7).Value
            .Cells(1, 6) = Sheets("Livre Inventaire").Cells(1, 8).Value
        End With
    End If
    'Ajout des donnees
    With Sheets(feuille)
        dlg = .Range("A" & .Rows.Count).End(xlUp).Row
        J = 1
        .Cells(dlg + 1, J) = tablo(i, J - 1)
        .Cells(dlg + 1, J + 1) = tablo(i, J)
        .Cells(dlg + 1, J + 4) = tablo(i, J + 5)
        .Cells(dlg + 1, J + 5) = tablo(i, J + 6)
    End With
    existe = 0
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

Sub Nettoyer()
Dim dlg As Long
Dim i As Byte

For i = 1 To Sheets.Count
'Rentrer ci-dessous le nom des feuilles que vous souhaitez ne pas nettoyer
    If CStr(Worksheets(i).Name) <> "Livre inventaire" And CStr(Worksheets(i).Name) <> "Sommaire" And CStr(Worksheets(i).Name) <> "CMUP Aberrants" And CStr(Worksheets(i).Name) <> "Export WiseUp" Then
        With Sheets(Sheets(i).Name)
            dlg = .UsedRange.Rows.Count
            If dlg >= 2 Then
                .Range("A2:B" & dlg).ClearContents
                .Range("E2:F" & dlg).ClearContents
            End If
        End With
    End If
Next i
End Sub
Le 19/10/2022 à 15:07

Bonjour

On est sur du 3 minutes, c'est beaucoup mieux.

Cela me parait encore long mais à voir en fonction de vos formules

Attention si vous avez des formules matricielles (genre sommeprod, etc...) qui font ralentir l'exécution

Crdlt

Rechercher des sujets similaires à "vba dupliquer donnees colonne onglet onglets"